home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / MISCEOUS / ZIP.LZH / ZIP.BAS < prev    next >
BASIC Source File  |  1990-02-02  |  61KB  |  1,702 lines
  1. 'ZIP - LAST MODIFIED NOVEMBER 31, 1988
  2. 'AUTHOR: STEVE PETERSEN, NATIONAL INSTITUTE OF STANDARDS AND TECHNOLOGY (301) 975-6136
  3. 'ZIP IS WRITTEN IN QUICKBasic version 4.0 (TM)
  4. 'ZIP MUST BE COMPILED WITH /X /O
  5. 'ZIP STARTED WITH /BAT RUNS IN BATCH MODE
  6. ZIP:
  7. CLEAR
  8. DBUG = 0  'WHEN DBUG=1 INTERMIEDIATE CALCULATIONS ARE WRITTEN TO A FILE CALLED DBUG.ZIP
  9. VERSION$ = COMMAND$
  10. IF VERSION$ = "" THEN VERSION = 1
  11. IF UCASE$(VERSION$) = "/BAT" THEN VERSION = 2
  12. 'VERSION = 2'USE THIS LINE WHEN RUNNING BATCH IN THE QUICKBASIC INTERPRETER ENVIRONMENT (NO COMMAND$)
  13. IF VERSION = 0 THEN PRINT "IMPROPER RUN PARAMETER (USE /BAT OR <CR>)": END
  14.  
  15. LOCATE , , 1, 6, 7  'CURSOR PARAMETERS
  16.  
  17. DIM P(4, 45), HUPW(6), REGFACTOR(12)
  18. DIM CAT$(10), NCAT(10), CODEAREA(10), MODEL(10), CODE$(50)
  19. DIM ADDR(10, 8), RW(12), OPTIMAL(12), NETSAVINGS(12), COMPONENT(12), COMP$(12), MESSAGE$(12), EXR(12)
  20. DIM BU$(50), life(2), EQUIPEFF$(5), GASEFF(5), OILEFF(5), SEER(5), HPHSPF(5), HPSEER(5)
  21. DIM RESISEFF(5), DUCTEFF(5), HSYS$(5), CSYS$(5), Energy$(5), LOW(10), HIGH(10)
  22. DIM ATTIC(8), FLOOR(8), CRAWL(8), cost(10, 8), TOTR(10, 8), BASEU(10)
  23. DIM RLEVEL(10), ULEVEL(10, 8), BETAH(10), BETAC(10), UNIT$(5), CF(5), REQUIV(10)
  24.  
  25. life(1) = 30 'study period for new house
  26. life(2) = 20 'study period for existing house
  27. DISCOUNTRATE = .07'does not include inflation
  28.  
  29. 'COMPONENTS:
  30. COMP$(1) = "Attic Insulation"
  31. COMP$(2) = "Wood-Frame Wall Insulation"
  32. COMP$(3) = "Masonry Wall Insulation"
  33. COMP$(4) = "Floors over Crawlspace"
  34. COMP$(5) = "Slab-Edge Insulation"
  35. COMP$(6) = "Crawlspace Wall Insulation"
  36. COMP$(7) = "Exterior Insulation for Deep Basement"
  37. COMP$(8) = "Interior Insulation for Deep Basement"
  38. COMP$(9) = "Exterior Insulation for Shallow Basement"
  39. COMP$(10) = "Interior Insulation for Shallow Basement"
  40.  
  41. 'EQUIPMENT EFFICIENCIES:
  42. EQUIPEFF$(1) = "LOW": EQUIPEFF$(2) = "MED": EQUIPEFF$(3) = "HIGH": EQUIPEFF$(4) = "VERY HIGH"
  43.    GASEFF(1) = .5:    GASEFF(2) = .65:   GASEFF(3) = .8:     GASEFF(4) = .9  'GAS AND OIL FURNACE EFF
  44.    OILEFF(1) = .5:    OILEFF(2) = .65:   OILEFF(3) = .8:     OILEFF(4) = .9  'GAS AND OIL FURNACE EFF
  45.      SEER(1) = 6!:      SEER(2) = 8!:      SEER(3) = 10!:      SEER(4) = 12! 'ELEC AC SEER
  46.    HPHSPF(1) = 5.5:   HPHSPF(2) = 6.5:   HPHSPF(3) = 7.5:    HPHSPF(4) = 8.5 'HP HSPF ZONE IV (FROM ARI DIRECTORY)
  47.    HPSEER(1) = 7.25:  HPSEER(2) = 8.75:  HPSEER(3) = 10.25:  HPSEER(4) = 11.75'HP SEER CORRESPONDING TO HSPF ABOVE
  48.    RESISEFF(1) = 1! 'ELECTRIC FURNACE
  49.    RESISEFF(2) = 1! 'BASEBOARD ELECTRIC
  50.    DUCTEFF(1) = .85 'ONE-STORY HOUSES
  51.    DUCTEFF(2) = .9  'TWO-STORY HOUSES
  52. HSYS$(1) = "NATURAL GAS FURNACE": HSYS$(2) = "OIL FURNACE": HSYS$(3) = "ELECTRIC FURNACE"
  53. HSYS$(4) = "ELECTRIC BASEBOARD": HSYS$(5) = "HEAT PUMP"
  54. CSYS$(0) = "NONE": CSYS$(1) = "CENTRAL-ELECTRIC": CSYS$(2) = "WINDOW UNIT - ELECTRIC": CSYS$(3) = "EVAPORATIVE COOLER"
  55.  
  56.  
  57. Energy$(1) = "ELECTRICITY": UNIT$(1) = "kWh": CF(1) = .003412
  58. Energy$(2) = "FUEL OIL": UNIT$(2) = "gallon": CF(2) = .14
  59. Energy$(3) = "LPG (PROPANE)": UNIT$(3) = "pound": CF(3) = .02156
  60. Energy$(4) = "NATURAL GAS": UNIT$(4) = "therm": CF(4) = .1
  61.  
  62. 'NEED ERROR TRAP IF NO CLIMATE.DAT FILE
  63. OPEN "R", 1, "CLIMATE.DAT"
  64. FIELD #1, 25 AS CTY$, 2 AS ST$, 2 AS COSTREG$, 2 AS DOE$, 2 AS HDD65$, 2 AS CDH74$
  65. BU = 0 'BACKUP INITIALIZER
  66.  
  67. IF VERSION = 1 THEN  'BEGIN INDIVIDUAL HOUSE
  68. GETZIP:
  69. GOSUB SCREEN1
  70.  
  71. LOCATE 10, 1
  72. PRINT "     ZIP was written at the National Institute of Standards and Technology"
  73. PRINT "     (formerly the National Bureau of Standards) to compute economic levels"
  74. PRINT "     of insulation for attics, walls, floors, crawlspaces, and basements."
  75. PRINT
  76. PRINT "  The economic level of insulation is the level that provides the greatest long-"
  77. PRINT "  term net savings to the homeowner, including a minimum rate of return of 7%"
  78. PRINT "  above inflation. (20 years used for existing houses, 30 years for new houses)."
  79. PRINT "     Print out the ZIP.DOC file on this disk for more information about ZIP."
  80.  
  81. LOCATE 19, 1:
  82. PRINT "     Calculations of energy savings in ZIP are keyed to 3-digit Zip Codes."
  83. LOCATE 21, 27: PRINT "(Enter X to exit program)"
  84. LOCATE 20, 71: COLOR 0, 7: PRINT "   ": COLOR 7, 0
  85. DEF SEG = 0: POKE 1050, PEEK(1052): DEF SEG 'CLEAR KEYBOARD BUFFER
  86. LOCATE 20, 7: PRINT "To start ZIP, please enter your Zip Code (first 3 digits only): ";
  87. AA$ = "": N = 0
  88. 100 A$ = INKEY$: IF A$ = "" THEN 100
  89. IF N = 0 AND UCASE$(A$) = "X" THEN CLS : END
  90. IF N > 0 AND A$ = CHR$(8) THEN
  91.    N = N - 1:
  92.    AA$ = MID$(AA$, 1, N):
  93.    X = POS(0) - 1:
  94.    LOCATE , X:
  95.    COLOR 0, 7: PRINT " "; : COLOR 7, 0:
  96.    LOCATE , X:
  97.    GOTO 100
  98. END IF
  99. IF INSTR("0123456789", A$) > 0 THEN AA$ = AA$ + A$: N = N + 1: PRINT A$;
  100. IF N < 3 THEN 100 ELSE ZIP$ = AA$
  101. IF ZIP$ = "" THEN GOTO GETZIP
  102. GETZIP2:
  103. ZIP = VAL(ZIP$): IF ZIP = 0 THEN DOE = 0: GOTO SORRY1
  104. GET #1, ZIP
  105. DOE = CVI(DOE$)
  106.  
  107. SORRY1:
  108. IF DOE = 0 THEN
  109.  CLS
  110.  LOCATE 15, 16: PRINT USING "Sorry, & is not a valid three-digit Zip Code"; ZIP$
  111.  LOCATE 17, 27: PRINT "Press <CR> to continue...";
  112. 2200 Q$ = INKEY$: IF Q$ = "" THEN 2200 ELSE Q$ = UCASE$(Q$)
  113. IF Q$ = "X" THEN CLS : END
  114. IF Q$ <> CHR$(13) THEN 2200
  115. GOTO GETZIP
  116. END IF
  117.  
  118. GOSUB CLIMATEDATA
  119. COSTREG = CVI(COSTREG$)
  120. CITY$ = CTY$
  121. STATE$ = ST$
  122. CLOSE
  123.  
  124. CITY:
  125. FOR I = 4 TO 19
  126.   IF MID$(CITY$, I, 1) = " " AND MID$(CITY$, I + 1, 1) = " " THEN CITY$ = MID$(CITY$, 1, I - 1) + ", " + STATE$: GOTO CITY
  127. NEXT I
  128.  
  129. 'HEATING DEGREE DAY MESSAGE
  130. IF HDD65 < 900 THEN HDD$ = "less than 1000"
  131. IF HDD65 >= 900 THEN
  132.  XX = HDD65 MOD 1000
  133.  X = INT(HDD65 / 1000) * 1000
  134.  Y$ = "s"
  135.  SELECT CASE XX
  136.    CASE 0 TO 100
  137.       X$ = "approximately"
  138.       Y$ = ""
  139.    CASE 101 TO 350
  140.       X$ = "in the low"
  141.    CASE 351 TO 650
  142.       X$ = "in the mid"
  143.    CASE 651 TO 899
  144.       X$ = "in the high"
  145.    CASE 900 TO 999
  146.       X$ = "approximately"
  147.       Y$ = ""
  148.       X = X + 1000
  149.  END SELECT
  150.  Z$ = STR$(X)
  151.  HDD$ = X$ + Z$ + Y$
  152. END IF
  153.  
  154. 'COOLING HOURS MESSAGE
  155.  CDH74 = INT(CDH74 / 1000 + .5) * 1000
  156.  Z$ = STR$(CDH74)
  157.  CH$ = "approximately" + Z$
  158.  
  159.  
  160. 'HDD CLASS
  161. SELECT CASE HDD65
  162.    CASE IS < 1000
  163.      HTG$ = "very low"
  164.    CASE 1000 TO 2500
  165.      HTG$ = "low"
  166.    CASE 2501 TO 4500
  167.      HTG$ = "moderate"
  168.    CASE 4501 TO 7000
  169.      HTG$ = "high"
  170.    CASE 7001 TO 9000
  171.      HTG$ = "very high"
  172.    CASE IS > 9000
  173.      HTG$ = "extremely high"
  174. END SELECT
  175.  
  176. 'COOLING HOUR CLASS
  177. SELECT CASE CDH74
  178.    CASE IS < 2000
  179.       CLG$ = "very low"
  180.    CASE 2000 TO 4999
  181.       CLG$ = "low"
  182.    CASE 5000 TO 9999
  183.       CLG$ = "moderate"
  184.    CASE 10000 TO 14999
  185.       CLG$ = "high"
  186.    CASE 15000 TO 24999
  187.       CLG$ = "very high"
  188.    CASE IS >= 25000
  189.       CLG$ = "extremely high"
  190. END SELECT
  191.  
  192. CLS
  193. LOCATE 5, 10: PRINT USING "The reference location for Zip & in the Zip Climate File is:"; ZIP$
  194. C = (79 - LEN(CITY$)) / 2
  195. COLOR 0, 7: LOCATE 7, C: PRINT CITY$: COLOR 7, 0
  196. SPACES = 35 + LEN(HDD$)
  197. LOCATE 9, (79 - SPACES) / 2: PRINT "Heating degree days (base 65F) are "; HDD$
  198. SPACES = LEN(HTG$) + 2
  199. LOCATE 10, (79 - SPACES) / 2: PRINT USING "(&)"; HTG$
  200. SPACES = 35 + LEN(CH$)
  201. LOCATE 12, (79 - SPACES) / 2: PRINT USING "Cooling degree hours above 74F are &"; CH$
  202. SPACES = LEN(CLG$) + 2
  203. LOCATE 13, (79 - SPACES) / 2: PRINT USING "(&)"; CLG$
  204. ADVISE$ = ""
  205. IF ZIP = 804 THEN ADVISE$ = "For Denver suburbs (e.g., Golden) use ZIP 800 (Denver)"
  206. IF ZIP = 860 THEN ADVISE$ = "At elevations lower than Flagstaff use ZIP 863 (Holbrook)"
  207. IF ZIP = 890 THEN ADVISE$ = "For locations close to Las Vegas use ZIP 891 (Las Vegas)"
  208. IF ZIP = 920 THEN ADVISE$ = "For inland locations use ZIP 925 (Riverside)"
  209. IF ZIP = 930 THEN ADVISE$ = "For inland locations use ZIP 915 (Burbank)"
  210. IF ZIP = 934 THEN ADVISE$ = "For coastal areas use ZIP 939 (Monterey)"
  211. IF ZIP = 939 THEN ADVISE$ = "For inland areas use ZIP 934 (San Luis Obispo)"
  212. IF ZIP = 945 THEN ADVISE$ = "For upper East Bay locations use ZIP 946 (Oakland)"
  213. IF ZIP = 950 THEN ADVISE$ = "For coastal and bay locations use ZIP 951 (San Jose)"
  214. IF ZIP = 954 THEN ADVISE$ = "For coastal areas use ZIP 949 (San Rafael)"
  215. IF ZIP = 967 OR ZIP = 968 THEN ADVISE$ = "Analysis for Hawaii only valid if air conditioning is used extensively."
  216. IF ADVISE$ <> "" THEN LOCATE 16, (79 - LEN(ADVISE$)) / 2: PRINT ADVISE$
  217.  
  218. PRINT : PRINT
  219. LOCATE 20, 63: COLOR 0, 7: PRINT "   ": COLOR 7, 0
  220. LOCATE 20, 17: PRINT "Press <CR> to proceed, or enter new Zip Code: ";
  221. AA$ = "": N = 0
  222. 200 A$ = INKEY$: IF A$ = "" THEN 200
  223. IF N = 0 AND UCASE$(A$) = "X" THEN CLS : END
  224. IF N = 0 AND A$ = CHR$(13) THEN GOTO HOUSETYPE
  225. IF N > 0 AND A$ = CHR$(8) THEN
  226.    N = N - 1:
  227.    AA$ = MID$(AA$, 1, N):
  228.    X = POS(0) - 1:
  229.    LOCATE , X:
  230.    COLOR 0, 7: PRINT " "; : COLOR 7, 0:
  231.    LOCATE , X:
  232.    GOTO 200
  233. END IF
  234. IF INSTR("0123456789", A$) > 0 THEN AA$ = AA$ + A$: N = N + 1: PRINT A$;
  235. IF N < 3 THEN 200 ELSE ZIP$ = AA$
  236. OPEN "R", 1, "CLIMATE.DAT"
  237. FIELD #1, 25 AS CTY$, 2 AS ST$, 2 AS COSTREG$, 2 AS DOE$, 2 AS HDD65$, 2 AS CDH74$
  238. GOTO GETZIP2
  239.  
  240.  
  241. HOUSETYPE:
  242. CLS
  243. LOCATE 6, 21: PRINT "Do you want insulation information for:"
  244. LOCATE 8, 30: PRINT "(1) NEW HOUSE"
  245. LOCATE 9, 30: PRINT "(2) EXISTING HOUSE"
  246. LOCATE 24, 1: PRINT "Note: You can back up at any question by entering B or start over by entering S";
  247. LOCATE 13, 25: PRINT "Enter your selection by number: "; :
  248. 300 Q$ = INKEY$: IF Q$ = "" THEN 300 ELSE Q$ = UCASE$(Q$)
  249. IF INSTR("SB12", Q$) = 0 THEN 300
  250. IF Q$ = "S" OR Q$ = "B" THEN GOTO ZIP
  251. HT = VAL(Q$)
  252.  
  253. BUP = 0 'INITIALIZE BACKUP INDEX
  254. HSYSSELECT:
  255. CLS
  256. LOCATE 5, 8: PRINT "         What type of primary heating system do you have?"
  257. LOCATE 7, 8: PRINT "(1) NATURAL GAS   (3) ELECTRIC FURNACE      (5) ELECTRIC HEAT PUMP"
  258. LOCATE 8, 8: PRINT "(2) OIL           (4) ELECTRIC BASEBOARD"
  259. LOCATE 10, 20: PRINT "Enter your selection by number (1-5): ";
  260. 400 Q$ = INKEY$: IF Q$ = "" THEN 400 ELSE Q$ = UCASE$(Q$)
  261. IF INSTR("SB12345", Q$) = 0 THEN 400
  262. IF Q$ = "B" THEN GOTO HOUSETYPE
  263. IF Q$ = "S" THEN GOTO ZIP
  264. HSYS = VAL(Q$)
  265. IF HSYS = 5 THEN CSYS = 5: AC = 1
  266. BUP = BUP + 1: BU$(BUP) = "HSYSSELECT"
  267. IF HSYS = 1 OR HSYS = 2 THEN
  268.   LOCATE 14, 16: PRINT "What is the approximate efficiency of your furnace?"
  269.   LOCATE 16, 16: PRINT " (1) LOW    (2) MEDIUM   (3) HIGH  (4) VERY HIGH"
  270.   LOCATE 17, 16: PRINT "     50%          65%         80%         90%"
  271. ELSEIF HSYS = 5 THEN
  272.   LOCATE 14, 16: PRINT "What is the approximate efficiency of your heat pump?"
  273.   LOCATE 16, 16: PRINT "  (1) LOW    (2) MEDIUM   (3) HIGH  (4) VERY HIGH"
  274. END IF
  275. IF HSYS = 1 OR HSYS = 2 OR HSYS = 5 THEN
  276. HEFFSELECT:
  277.   LOCATE 18, 21: PRINT "Enter your selection by number (1-4),"
  278.   LOCATE 19, 21: PRINT "or press <CR> to default to medium: ";
  279. 500 Q$ = INKEY$: IF Q$ = "" THEN 500 ELSE Q$ = UCASE$(Q$)
  280.   IF INSTR("SB1234", Q$) = 0 AND Q$ <> CHR$(13) THEN 500
  281.   IF Q$ = "B" THEN GOTO BACKUP
  282.   IF Q$ = "S" THEN GOTO ZIP
  283.   IF Q$ = CHR$(13) THEN Q$ = "2" 'DEFAULT = MEDIUM
  284.   EFF = VAL(Q$)
  285. END IF
  286.  
  287. DUCTS:
  288. IF HSYS <> 4 THEN
  289.   CLS
  290.   LOCATE 8, 7: PRINT "Do you have ductwork in attic, crawlspace, or other unheated areas?"
  291.   LOCATE 20, 7: PRINT "(If there is ductwork in these areas, duct losses will be estimated"
  292.   LOCATE 21, 7: PRINT "   in calculating the energy savings from any added insulation.)"
  293.   LOCATE 9, 35: PRINT "Enter Y or N: ";
  294. 600 Q$ = INKEY$: IF Q$ = "" THEN 600 ELSE Q$ = UCASE$(Q$)
  295.   IF INSTR("SBYN", Q$) = 0 THEN 600
  296.   IF Q$ = "B" THEN GOTO BACKUP
  297.   IF Q$ = "S" THEN GOTO ZIP
  298.   IF Q$ = "N" THEN DUCTS = 0
  299.   IF Q$ = "Y" THEN
  300.      DUCTS = 1
  301.      LOCATE 10, 20: PRINT "Does house have 2 or more stories (Y/N)? ";
  302. 700  Q$ = INKEY$: IF Q$ = "" THEN 700 ELSE Q$ = UCASE$(Q$)
  303.      IF INSTR("SBYN", Q$) = 0 THEN 700
  304.      IF Q$ = "B" THEN CLS : GOTO DUCTS
  305.      IF Q$ = "S" THEN GOTO ZIP
  306.      IF Q$ = "Y" THEN STORIES = 2 ELSE STORIES = 1
  307.   END IF
  308. BUP = BUP + 1: BU$(BUP) = "DUCTS"
  309. END IF
  310.  
  311. GOSUB HEATINGSYSEFF
  312.  
  313. CSYSSELECT:
  314. IF HSYS <> 5 THEN 'BEGIN COOLING SYSTEM DEFINITION
  315.   CLS
  316.   LOCATE 5, 14: PRINT "What type of air conditioning system do you have?"
  317.   LOCATE 7, 14: PRINT "(0) NONE                  (2) WINDOW UNIT-ELECTRIC"
  318.   LOCATE 8, 14: PRINT "(1) CENTRAL-ELECTRIC      (3) EVAPORATIVE COOLER"
  319.   LOCATE 10, 14: PRINT "    Enter your selection by number (0-3): ";
  320. 800 Q$ = INKEY$: IF Q$ = "" THEN 800 ELSE Q$ = UCASE$(Q$)
  321.   IF INSTR("SB0123", Q$) = 0 THEN 800
  322.   IF Q$ = "B" THEN GOTO BACKUP
  323.   IF Q$ = "S" THEN GOTO ZIP
  324.   CSYS = VAL(Q$)
  325.   AC = 0: IF CSYS = 1 OR CSYS = 2 THEN AC = 1
  326.   BUP = BUP + 1: BU$(BUP) = "CSYSSELECT"
  327.   IF AC = 1 THEN 'GET AIR CONDITIONER EFFICIENCY
  328.     LOCATE 15, 11: PRINT "What is the approximate efficiency of your air conditioner?"
  329.     LOCATE 17, 11: PRINT "      (1) LOW   (2) MEDIUM   (3) HIGH  (4) VERY HIGH"
  330.     LOCATE 18, 11: PRINT "   SEER:   6          8           10           12"
  331. EFFCOOLING:
  332.     LOCATE 20, 20: PRINT "Enter your selection by number (1-4),"
  333.     LOCATE 21, 20: PRINT " or press <CR> to default to medium: ";
  334. 900 Q$ = INKEY$: IF Q$ = "" THEN 900 ELSE Q$ = UCASE$(Q$)
  335.     IF INSTR("SB1234", Q$) = 0 AND Q$ <> CHR$(13) THEN 900
  336.     IF Q$ = "B" THEN GOTO BACKUP
  337.     IF Q$ = "S" THEN GOTO ZIP
  338.     IF Q$ = CHR$(13) THEN Q$ = "2"  'DEFAULT TO MEDIUM
  339.     EFF = VAL(Q$)
  340.     GOSUB COOLINGSYSEFF
  341.   END IF  'END AC EFFICIENCY
  342. END IF  'END COOLING SYSTEM DEFINITION
  343.  
  344. SHOWPRICES:
  345. CLS
  346. GOSUB ENPRICES
  347. HUNIT$ = UNIT$(HENERGY): HENERGY$ = Energy$(HENERGY): HCF = CF(HENERGY): HP = P(HENERGY, PIVOTYR) * GNPDEF1
  348. CUNIT$ = UNIT$(CENERGY): CENERGY$ = Energy$(CENERGY): CCF = CF(CENERGY): CP = P(CENERGY, PIVOTYR) * GNPDEF1
  349. LOCATE 5, 10: PRINT USING "Default & price for space heating =$$#.###/&"; HENERGY$, HP * HCF, HUNIT$
  350. IF AC = 1 THEN
  351. LOCATE 7, 10: PRINT USING "Default & price for space cooling =$$#.###/&"; CENERGY$, CP * CCF, CUNIT$
  352. IF HENERGY = 4 THEN LOCATE 23, 3: PRINT "Note: A 'therm' of gas is 100,000 Btu, or approximately 100 cubic feet.";
  353.  IF HENERGY = 1 AND CENERGY = 1 THEN
  354.    LOCATE 20, 1: PRINT "   Note: summer and winter electricity rates are different in many areas.";
  355.          PRINT "   If they are different in your area, the rates shown above should be changed";
  356.          PRINT "   to reflect this.  (Use summer rates for cooling, winter rates for heating.)";
  357.  END IF
  358. END IF
  359.  
  360. J = HENERGY: GOSUB UPW: HUPW = UPW
  361. IF AC = 1 THEN
  362.    IF CENERGY = HENERGY THEN CUPW = HUPW
  363.    IF CENERGY <> HENERGY THEN
  364.      J = CENERGY
  365.      GOSUB UPW
  366.      CUPW = UPW
  367.    END IF
  368. END IF
  369.  
  370. CHANGEENERGYPRICES:
  371. PRINT
  372. IF AC = 1 THEN LOCATE 12, 14: PRINT "Do you want to change these energy prices to better "
  373. IF AC = 0 THEN LOCATE 12, 14: PRINT "Do you want to change this energy price to better "
  374. LOCATE 13, 25: PRINT "reflect local prices (Y/N)? ";
  375. 1000 Q$ = INKEY$: IF Q$ = "" THEN 1000 ELSE Q$ = UCASE$(Q$)
  376. IF INSTR("SBYN", Q$) = 0 THEN 1000
  377. IF Q$ = "B" THEN GOTO BACKUP
  378. IF Q$ = "S" THEN GOTO ZIP
  379. IF Q$ = "Y" THEN 'ACCEPTABLE PRICE RANGES FOR ENERGY
  380.    LOW(1) = .03: HIGH(1) = .2'ELECTRICITY
  381.    LOW(2) = .75: HIGH(2) = 2!'FUEL OIL
  382.    LOW(3) = .75: HIGH(3) = 3!'LPG
  383.    LOW(4) = .3: HIGH(4) = 1.25'NAT GAS
  384. CHANGEHEATPRICE:
  385.    CLS
  386.    LOCATE 18, 20: PRINT "Press <CR> when entry is completed.";
  387.    IF HENERGY = 4 THEN LOCATE 23, 3: PRINT "Note: A 'therm' of gas is 100,000 Btu, or approximately 100 cubic feet.";
  388.    LOCATE 5, 13: PRINT USING "Enter current & price for heating ($/&)"; HENERGY$, HUNIT$
  389.    LOCATE 6, 25: INPUT "or press <CR> if no change: ", Q$: Q$ = UCASE$(Q$)
  390.     IF Q$ = "B" THEN GOTO SHOWPRICES
  391.     IF Q$ = "S" THEN GOTO ZIP
  392.     IF Q$ <> "" THEN
  393.      IF MID$(Q$, 1, 1) = "$" THEN Q$ = MID$(Q$, 2, 6)
  394.      HHP = VAL(Q$)
  395.      IF HHP < LOW(HENERGY) OR HHP > HIGH(HENERGY) THEN
  396.       LOCATE 9, 15: PRINT USING "& price must be between $$#.## and $$#.##/&"; HENERGY$, LOW(HENERGY), HIGH(HENERGY), HUNIT$
  397.       LOCATE 18, 1: PRINT STRING$(79, " ");
  398.       LOCATE 12, 27: PRINT "Press <CR> to continue...";
  399. 2900  Q$ = INKEY$: IF Q$ = "" THEN 2900 ELSE Q$ = UCASE$(Q$)
  400.       IF INSTR("S", Q$) = 0 AND Q$ <> CHR$(13) THEN 2900
  401.       IF Q$ = "S" THEN GOTO ZIP  'NO BACKUP ALLOWED HERE
  402.       GOTO CHANGEHEATPRICE
  403.      END IF
  404.      HP = HHP / HCF
  405.    END IF
  406.  
  407. CHANGECOOLPRICE:
  408.    IF AC = 1 THEN
  409.      LOCATE 18, 20: PRINT "Press <CR> when entry is completed.";
  410.      LOCATE 15, 13: PRINT USING "Enter current & price for cooling ($/&)"; CENERGY$, CUNIT$
  411.      LOCATE 16, 25: INPUT "or press <CR> if no change: ", Q$: Q$ = UCASE$(Q$)
  412.      IF Q$ = "B" THEN GOTO SHOWPRICES
  413.      IF Q$ = "S" THEN GOTO ZIP
  414.      IF Q$ <> "" THEN
  415.        IF MID$(Q$, 1, 1) = "$" THEN Q$ = MID$(Q$, 2, 6)
  416.        CCP = VAL(Q$)
  417.        IF CCP < LOW(CENERGY) OR CCP > HIGH(CENERGY) THEN
  418.      LOCATE 18, 15: PRINT USING "& price must be between $$#.## and $$#.##/&"; CENERGY$, LOW(CENERGY), HIGH(CENERGY), CUNIT$
  419.      LOCATE 19, 27: PRINT "Press <CR> to continue...";
  420. 3000     Q$ = INKEY$: IF Q$ = "" THEN 3000 ELSE Q$ = UCASE$(Q$)
  421.      IF INSTR("S", Q$) = 0 AND Q$ <> CHR$(13) THEN 3000
  422.      IF Q$ = "S" THEN GOTO ZIP
  423.      CLS : GOTO CHANGECOOLPRICE
  424.        END IF
  425.        CP = CCP / CCF
  426.       END IF
  427.    END IF
  428. END IF
  429. BUP = BUP + 1: BU$(BUP) = "SHOWPRICES"
  430.  
  431. NEWHOUSE:
  432. IF HT = 1 THEN
  433. COMPONENTMENUNEW:
  434.   INSCOST$ = "INSCOST.NEW": GOSUB INSCOST
  435.   BU = 0: GOSUB MENU: IF BU = 1 THEN GOTO BACKUP
  436.   EXATTIC = 0: EXFLOOR = 0: EXCRAWL = 0
  437.   BUP = BUP + 1: BU$(BUP) = "COMPONENTMENUNEW"
  438. END IF          'END NEW HOUSE
  439.  
  440.  
  441. RETROFIT:
  442. IF HT = 2 THEN
  443. COMPONENTMENURET:
  444.    INSCOST$ = "INSCOST.RET": GOSUB INSCOST
  445.    BU = 0: GOSUB MENU: IF BU = 1 THEN GOTO BACKUP
  446.    BUP = BUP + 1: BU$(BUP) = "COMPONENTMENURET"
  447.   
  448.   
  449.    IF COMPONENT(1) = 1 THEN
  450. ATTIC:
  451.     ATTIC(0) = 0: ATTIC(1) = 7: ATTIC(2) = 11: ATTIC(3) = 19: ATTIC(4) = 22: ATTIC(5) = 30: ATTIC(6) = 38
  452.     CLS
  453.     LOCATE 3, 15: PRINT "   How much insulation is there in your attic now?"
  454.     LOCATE 5, 15: PRINT "                    Approximate Equivalent in Inches"
  455.     LOCATE 6, 15: PRINT "  Existing          --------------------------------"
  456.     LOCATE 7, 15: PRINT " Insulation              Fiberglass       Cellulosic"
  457.     LOCATE 8, 15: PRINT "   Level            --------------------    Blown"
  458.     LOCATE 9, 15: PRINT "------------------  Batt       Blown      ----------"
  459.     LOCATE 10, 15: PRINT "(0) None             O           O            O"
  460.     LOCATE 11, 15: PRINT "(1) R-7             2.5       2.0 -3.0     2.0-3.0"
  461.     LOCATE 12, 15: PRINT "(2) R-11            3.5       3.75-5.0     3.0-3.5"
  462.     LOCATE 13, 15: PRINT "(3) R-19            6.0       6.5 -8.75    5.0-6.0"
  463.     LOCATE 14, 15: PRINT "(4) R-22            7.0       7.5 -10.0    6.0-7.0"
  464.     LOCATE 15, 15: PRINT "(5) R-30            9.0      10.25-13.75   8.0-9.5"
  465.     LOCATE 16, 15: PRINT "(6) R-38           12.0      13.75-18.25  10.3-12.0"
  466. ATTIC1:
  467.     LOCATE 18, 20: PRINT "Enter your selection by number (0-6): ";
  468. 1200 Q$ = INKEY$: IF Q$ = "" THEN 1200 ELSE Q$ = UCASE$(Q$)
  469.     IF INSTR("SB0123456", Q$) = 0 THEN 1200
  470.     IF Q$ = "B" THEN GOTO BACKUP
  471.     IF Q$ = "S" THEN GOTO ZIP
  472.     EXATTIC = VAL(Q$)
  473.     BUP = BUP + 1: BU$(BUP) = "ATTIC"
  474.   END IF 'component(1)=1
  475.  
  476.    IF COMPONENT(2) = 1 THEN
  477. WFWALL:
  478.     CLS
  479.     LOCATE 3, 13: PRINT "             Exterior Wood-Frame Walls:"
  480.     LOCATE 5, 13: PRINT "Do these walls already contain some insulation (Y/N)? ";
  481. 1300 Q$ = INKEY$: IF Q$ = "" THEN 1300 ELSE Q$ = UCASE$(Q$)
  482.     IF INSTR("SBYN", Q$) = 0 THEN 1300
  483.     IF Q$ = "B" THEN GOTO BACKUP
  484.     IF Q$ = "S" THEN GOTO ZIP
  485.     IF Q$ = "Y" THEN
  486.       LOCATE 7, 10: PRINT "Exterior wood frame walls that already have some insulation "
  487.       LOCATE 8, 10: PRINT "are not usually economic to reinsulate and are not included"
  488.       LOCATE 9, 10: PRINT "                in this analysis."
  489.       COMPONENT(2) = 0
  490.       LOCATE 15, 27: PRINT "Press <CR> to continue...";
  491. 2300  Q$ = INKEY$: IF Q$ = "" THEN 2300 ELSE Q$ = UCASE$(Q$)
  492.       IF INSTR("SB", Q$) = 0 AND Q$ <> CHR$(13) THEN 2300
  493.       IF Q$ = "B" THEN GOTO BACKUP
  494.       IF Q$ = "S" THEN GOTO ZIP
  495.     END IF
  496.    BUP = BUP + 1: BU$(BUP) = "WFWALL"
  497.    END IF
  498.  
  499.  
  500.    IF COMPONENT(3) = 1 THEN
  501. MWALL:
  502.     CLS
  503.     LOCATE 3, 5: PRINT "                       Exterior Masonry Walls:"
  504.     LOCATE 5, 5: PRINT "  Insulation of masonry walls in existing houses is typically impractical"
  505.     LOCATE 6, 5: PRINT "unless you are about to install new wall board or an exterior wall covering."
  506.     LOCATE 8, 5: PRINT "    Do you still want to include insulation of masonry walls (Y/N)? ";
  507. 1400 Q$ = INKEY$: IF Q$ = "" THEN 1400 ELSE Q$ = UCASE$(Q$)
  508.     IF INSTR("SBYN", Q$) = 0 THEN 1400
  509.     IF Q$ = "B" THEN GOTO BACKUP
  510.     IF Q$ = "S" THEN GOTO ZIP
  511.     IF Q$ = "N" THEN COMPONENT(3) = 0
  512.     IF Q$ = "Y" THEN
  513.       LOCATE 11, 5: PRINT " The economic analysis of insulation of masonry walls will not include"
  514.       LOCATE 12, 5: PRINT "the cost of removing and replacing the wall covering unless these costs "
  515.       LOCATE 13, 5: PRINT "   are specifically included in the insulation costs displayed below."
  516.       LOCATE 15, 5: PRINT "                    Press <CR> to continue...";
  517. 3100  Q$ = INKEY$: IF Q$ <> CHR$(13) THEN 3100
  518.     END IF
  519.    BUP = BUP + 1: BU$(BUP) = "MWALL"
  520.    END IF
  521.             
  522.    IF COMPONENT(4) = 1 THEN
  523. FLOOR:
  524.     IF FLAG6 = 1 THEN COMPONENT(6) = 1'RESTORE COMPONENT(6) IF BACKUP USED TO GET HERE
  525.     FLOOR(0) = 0: FLOOR(1) = 7: FLOOR(2) = 11: FLOOR(3) = 13: FLOOR(4) = 19
  526.     CLS
  527.     LOCATE 1, 18: PRINT "        Floors over Crawlspaces:"
  528.     LOCATE 3, 18: PRINT "How much insulation is under the floor now?"
  529.     LOCATE 5, 26: PRINT "  Approximate   Approximate"
  530.     LOCATE 6, 26: PRINT "    R-Value      Thickness"
  531.     LOCATE 7, 26: PRINT "                 (inches)"
  532.     LOCATE 8, 26: PRINT "(0)  R-0            0"
  533.     LOCATE 9, 26: PRINT "(1)  R-7           2.5"
  534.     LOCATE 10, 26: PRINT "(2)  R-11          3.5"
  535.     LOCATE 11, 26: PRINT "(3)  R-13          4.O"
  536.     LOCATE 12, 26: PRINT "(4)  R-19          6.0"
  537. FLOOR1:
  538.     LOCATE 14, 18: PRINT "Enter your selection by number (0-4): ";
  539. 1500 Q$ = INKEY$: IF Q$ = "" THEN 1500 ELSE Q$ = UCASE$(Q$)
  540.     IF INSTR("SB01234", Q$) = 0 THEN 1500
  541.     IF Q$ = "B" THEN GOTO BACKUP
  542.     IF Q$ = "S" THEN GOTO ZIP
  543.     EXFLOOR = VAL(Q$)
  544.     BUP = BUP + 1: BU$(BUP) = "FLOOR"
  545.    END IF 'comp(4)=1
  546.  
  547.     IF COMPONENT(6) = 1 THEN
  548. CRAWL:
  549.     IF EXFLOOR > 0 THEN
  550.       CLS
  551.       LOCATE 4, 10: PRINT "                        Crawlspace Walls:"
  552.       
  553.       LOCATE 6, 10: PRINT "  You already have insulation under the floor above crawlspace."
  554.       LOCATE 7, 10: PRINT "Insulation of crawlspace walls is unlikely to be economic and will"
  555.       LOCATE 8, 10: PRINT "               not be evaluated in this analysis."
  556.       COMPONENT(6) = 0: FLAG6 = 1 'FLAG6=1 MEANS THAT COMPONENT(6) HAD BEEN =1
  557.       LOCATE 15, 27: PRINT "Press <CR> to continue...";
  558. 2400  Q$ = INKEY$: IF Q$ = "" THEN 2400 ELSE Q$ = UCASE$(Q$)
  559.       IF INSTR("SB", Q$) = 0 AND Q$ <> CHR$(13) THEN 2400
  560.       IF Q$ = "B" THEN GOTO BACKUP
  561.       IF Q$ = "S" THEN GOTO ZIP
  562.     END IF
  563.   END IF
  564.   IF COMPONENT(6) = 1 THEN
  565.     CRAWL(0) = 0: CRAWL(1) = 7: CRAWL(2) = 11: CRAWL(3) = 13: CRAWL(4) = 19
  566.     CLS
  567.     LOCATE 1, 15: PRINT "                Crawlspace Walls:"
  568.     LOCATE 3, 15: PRINT "How much insulation is on the crawlspace walls now?"
  569.     LOCATE 5, 23: PRINT "  Approximate   Approximate"
  570.     LOCATE 6, 23: PRINT "    R-Value      Thickness"
  571.     LOCATE 7, 23: PRINT "                  (inches)"
  572.     LOCATE 8, 23: PRINT "(0)  R-0            0"
  573.     LOCATE 9, 23: PRINT "(1)  R-7           2.5"
  574.     LOCATE 10, 23: PRINT "(2)  R-11          3.5"
  575.     LOCATE 11, 23: PRINT "(3)  R-13          4.O"
  576.     LOCATE 12, 23: PRINT "(4)  R-19          6.0"
  577. CRAWL1:
  578.     LOCATE 14, 20: PRINT "Enter your selection by number (0-4): ";
  579. 1600 Q$ = INKEY$: IF Q$ = "" THEN 1600 ELSE Q$ = UCASE$(Q$)
  580.     IF INSTR("SB01234", Q$) = 0 THEN 1600
  581.     IF Q$ = "B" THEN GOTO BACKUP
  582.     IF Q$ = "S" THEN GOTO ZIP
  583.     EXCRAWL = VAL(Q$)
  584.     BUP = BUP + 1: BU$(BUP) = "CRAWL"
  585.    END IF
  586.  
  587.    IF EXCRAWL > 0 AND COMPONENT(4) = 1 THEN
  588.       CLS
  589.       LOCATE 4, 5: PRINT "Since you already have insulation on the crawlspace walls rather than under"
  590.       LOCATE 5, 5: PRINT " the floor, any additional insulation will be evaluated for the walls only."
  591.       LOCATE 6, 5: PRINT "             Insulation under the floor will not be evaluated."
  592.       LOCATE 10, 5: PRINT "                     Press <CR> to continue...";
  593. 2500  Q$ = INKEY$: IF Q$ = "" THEN 2500 ELSE Q$ = UCASE$(Q$)
  594.       IF INSTR("SB", Q$) = 0 AND Q$ <> CHR$(13) THEN 2500
  595.       IF Q$ = "B" THEN GOTO BACKUP
  596.       IF Q$ = "S" THEN GOTO ZIP
  597.       COMPONENT(4) = 0   'DELETE INSULATION UNDER FLOORS
  598.    END IF
  599.  
  600.    IF COMPONENT(5) = 1 THEN
  601. SLAB:
  602.      CLS
  603.      LOCATE 1, 10: PRINT "                      Concrete Slab Floors:"
  604.      LOCATE 3, 10: PRINT "Do you already have perimeter insulation around the concrete"
  605.      LOCATE 4, 10: PRINT "                    slab of your house (Y/N)? ";
  606. 1700 Q$ = INKEY$: IF Q$ = "" THEN 1700 ELSE Q$ = UCASE$(Q$)
  607.     IF INSTR("SBYN", Q$) = 0 THEN 1700
  608.     IF Q$ = "B" THEN GOTO BACKUP
  609.     IF Q$ = "S" THEN GOTO ZIP
  610.     IF Q$ = "Y" THEN
  611.        LOCATE 7, 10: PRINT "Further slab edge insulation is not likely to be cost effective"
  612.        LOCATE 8, 10: PRINT "and will not be evaluated in this analysis."
  613.        COMPONENT(5) = 0
  614.        LOCATE 15, 27: PRINT "Press <CR> to continue...";
  615. 3200  Q$ = INKEY$: IF Q$ <> CHR$(13) THEN 3200
  616.      END IF
  617.    BUP = BUP + 1: BU$(BUP) = "SLAB"
  618.    END IF
  619.  
  620.  
  621.  
  622.    IF COMPONENT(7) = 1 OR COMPONENT(8) = 1 OR COMPONENT(9) = 1 OR COMPONENT(10) = 1 THEN
  623. BASEMENT:
  624.      CLS
  625.      LOCATE 1, 10: PRINT "                  Basement Wall Insulation:"
  626.      LOCATE 3, 10: PRINT "Is there some existing insulation in the basement wall (Y/N)? ";
  627. 1800 Q$ = INKEY$: IF Q$ = "" THEN 1800 ELSE Q$ = UCASE$(Q$)
  628.     IF INSTR("SBYN", Q$) = 0 THEN 1800
  629.     IF Q$ = "B" THEN GOTO BACKUP
  630.     IF Q$ = "S" THEN GOTO ZIP
  631.     IF Q$ = "Y" THEN
  632.       LOCATE 5, 7: PRINT "Further basement wall insulation is not likely to be economic and"
  633.       LOCATE 6, 7: PRINT "               is not evaluated in this analysis. "
  634.       COMPONENT(7) = 0: COMPONENT(8) = 0: COMPONENT(9) = 0: COMPONENT(10) = 0
  635.       LOCATE 15, 27: PRINT "Press <CR> to continue...";
  636. 2600  Q$ = INKEY$: IF Q$ = "" THEN 2600 ELSE Q$ = UCASE$(Q$)
  637.       IF INSTR("SB", Q$) = 0 AND Q$ <> CHR$(13) THEN 2600
  638.       IF Q$ = "B" THEN GOTO BACKUP
  639.       IF Q$ = "S" THEN GOTO ZIP
  640.      END IF
  641.    BUP = BUP + 1: BU$(BUP) = "BASEMENT"
  642.    END IF
  643.  
  644.  
  645.    IF COMPONENT(7) = 1 THEN
  646. EXTDPBASE:
  647.     CLS
  648.     LOCATE 3, 10: PRINT "         Exterior Insulation for Deep Basements:"
  649.     LOCATE 5, 10: PRINT "For existing houses with deep basements, exterior insulation"
  650.     LOCATE 6, 10: PRINT "  is generally practical for only the top half of the wall."
  651.     LOCATE 8, 10: PRINT "    Only the top half will be evaluated in this analysis."
  652.     LOCATE 15, 27: PRINT "Press <CR> to continue...";
  653. 2700 Q$ = INKEY$: IF Q$ = "" THEN 2700 ELSE Q$ = UCASE$(Q$)
  654.     IF INSTR("SB", Q$) = 0 AND Q$ <> CHR$(13) THEN 2700
  655.     IF Q$ = "B" THEN GOTO BACKUP
  656.     IF Q$ = "S" THEN GOTO ZIP
  657.    BUP = BUP + 1: BU$(BUP) = "EXTDPBASE"
  658.    END IF
  659.  
  660.    IF COMPONENT(8) = 1 OR COMPONENT(10) = 1 THEN
  661. INTBASE:
  662.     CLS
  663.     LOCATE 3, 15: PRINT "      Basement Walls (Interior Insulation):"
  664.     LOCATE 5, 15: PRINT "Are the basement walls already finished off (Y/N)? ";
  665. 1900 Q$ = INKEY$: IF Q$ = "" THEN 1900 ELSE Q$ = UCASE$(Q$)
  666.     IF INSTR("SBYN", Q$) = 0 THEN 1900
  667.     IF Q$ = "B" THEN GOTO BACKUP
  668.     IF Q$ = "S" THEN GOTO ZIP
  669.     IF Q$ = "Y" THEN
  670.       LOCATE 10, 3: PRINT "    Insulation of the interior basement walls is generally not economic"
  671.       LOCATE 11, 3: PRINT "if the walls are already finished.  Consider using exterior wall insulation."
  672.       COMPONENT(8) = 0: COMPONENT(10) = 0
  673.       LOCATE 15, 27: PRINT "Press <CR> to continue...";
  674. 2800  Q$ = INKEY$: IF Q$ = "" THEN 2800 ELSE Q$ = UCASE$(Q$)
  675.       IF INSTR("SB", Q$) = 0 AND Q$ <> CHR$(13) THEN 2800
  676.       IF Q$ = "B" THEN GOTO BACKUP
  677.       IF Q$ = "S" THEN GOTO ZIP
  678.     END IF
  679.    BUP = BUP + 1: BU$(BUP) = "INTBASE"
  680.    END IF
  681.  
  682. END IF 'END RETROFIT EXISTING HOUSE
  683.  
  684. INSPRICECHANGE:
  685. CLS
  686. PRINT "  The following prices will be used to compute economic levels of insulation"
  687. PRINT "                  for your house unless you change them:"
  688.  
  689. IF COMPONENT(1) = 1 THEN  'ATTIC INSULATION
  690. COMP1:
  691.   ICOST = 1
  692.   INS$ = "Attic Insulation Costs:"
  693.   EX1 = EXATTIC
  694.   EX2 = ATTIC(EXATTIC)
  695.   IF HT = 1 THEN BU = 10 ELSE BU = 11'BACKUP CODES
  696.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  697.   BUP = BUP + 1: BU$(BUP) = "COMP1"
  698. END IF
  699.  
  700. IF COMPONENT(2) = 1 THEN
  701. COMP2:
  702.   ICOST = 2
  703.   INS$ = "Wood-Frame Wall Insulation Costs:"
  704.   EX1 = 0
  705.   BU = 11
  706.   CLS
  707.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  708.   BUP = BUP + 1: BU$(BUP) = "COMP2"
  709. END IF
  710.  
  711. IF COMPONENT(3) = 1 THEN
  712. COMP3:
  713.   ICOST = 3
  714.   INS$ = "Masonry Wall Insulation Costs:"
  715.   EX1 = 0
  716.   BU = 11
  717.   CLS
  718.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  719.   BUP = BUP + 1: BU$(BUP) = "COMP3"
  720.   END IF
  721.  
  722. IF COMPONENT(4) = 1 THEN
  723. COMP4:
  724.   ICOST = 4
  725.   INS$ = "Floor Insulation Costs:"
  726.   EX1 = EXFLOOR
  727.   EX2 = FLOOR(EXFLOOR)
  728.   BU = 11
  729.   CLS
  730.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  731.   BUP = BUP + 1: BU$(BUP) = "COMP4"
  732. END IF
  733.  
  734. IF COMPONENT(5) = 1 THEN
  735. COMP5:
  736.   ICOST = 5
  737.   INS$ = "Slab-on-Grade Insulation Costs:"
  738.   EX1 = 0
  739.   BU = 11
  740.   CLS
  741.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  742.   BUP = BUP + 1: BU$(BUP) = "COMP5"
  743.   
  744. END IF
  745.  
  746. IF COMPONENT(6) = 1 THEN 'BEGIN CRAWLCOST
  747. COMP6:
  748.   ICOST = 6
  749.   INS$ = "Crawlspace Wall Insulation Costs:"
  750.   EX1 = EXCRAWL
  751.   EX2 = CRAWL(EXCRAWL)
  752.   BU = 11
  753.   CLS
  754.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  755.   BUP = BUP + 1: BU$(BUP) = "COMP6"
  756. END IF
  757.  
  758. IF COMPONENT(7) = 1 THEN
  759. COMP7:
  760.   ICOST = 7
  761.   INS$ = "Exterior Insulation on Deep Basement Walls"
  762.   EX1 = 0
  763.   BU = 11
  764.   CLS
  765.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  766.   BUP = BUP + 1: BU$(BUP) = "COMP7"
  767. END IF
  768.  
  769. IF COMPONENT(8) = 1 OR COMPONENT(10) = 1 THEN
  770. COMP8:
  771.   ICOST = 8
  772.   INS$ = "Interior Insulation on Basement Walls"
  773.   EX1 = 0
  774.   BU = 11
  775.   CLS
  776.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  777.   BUP = BUP + 1: BU$(BUP) = "COMP8"
  778. END IF
  779.  
  780. IF COMPONENT(9) = 1 THEN
  781. COMP9:
  782.   ICOST = 9
  783.   INS$ = "Exterior Insulation on Shallow Basement Walls:"
  784.   EX1 = 0
  785.   BU = 11
  786.   CLS
  787.   BU = 0: GOSUB COSTDISPLAY: IF BU = 1 THEN GOTO BACKUP
  788.   BUP = BUP + 1: BU$(BUP) = "COMP9"
  789. END IF
  790.  
  791. IF COMPONENT(10) = 1 THEN   'INTERIOR INSULATION ON SHALLOW BASEMENT WALLS
  792. COMP10:
  793.    OLD = 8   'USE SAME COSTS AS INTERIOR INSULATION ON DEEP BASEMENT WALLS
  794.    new = 10
  795.    NCAT(new) = NCAT(OLD)
  796.    CODEAREA(new) = CODEAREA(OLD)
  797.    MODEL(new) = MODEL(OLD)
  798.    FOR K = 1 TO NCAT(new)
  799.       ADDR(new, K) = ADDR(OLD, K)
  800.       cost(new, K) = cost(OLD, K)
  801.    NEXT K
  802. END IF
  803.   
  804. GOSUB COMPUTESAVINGS
  805. GOTO PRINTREPORT
  806.  
  807. END IF  'END INDIVIDUAL HOUSE ANALYSIS
  808.  
  809. '----------------------------------------------------------------------------
  810. IF VERSION = 2 THEN 'BEGIN ANALYSIS OF ALL ZIPS
  811. GOSUB SCREEN1
  812.  
  813. GETZIPS:
  814.   PRINT
  815.   PRINT "                           Analysis for All Zip Codes:"
  816. firstzip:
  817.   LOCATE 10, 1
  818.   INPUT "                Enter first Zip Code for analysis (3 digits): ", firstzip
  819.   IF firstzip < 10 OR firstzip > 999 THEN
  820.     LOCATE 12, 30: PRINT "Invalid Zip Code"
  821.     LOCATE 10, 60: PRINT STRING$(10, " ")
  822.     GOTO firstzip
  823.   END IF
  824. lastzip:
  825.   LOCATE 12, 1
  826.   INPUT "                Enter last Zip Code for analysis (3 digits): ", lastzip
  827.   IF lastzip < 10 OR lastzip > 999 THEN
  828.     LOCATE 15, 15: PRINT "Invalid Zip Code...Try again"
  829.     LOCATE 12, 1: PRINT STRING$(70, " ")
  830.     GOTO lastzip
  831.   END IF
  832.   IF lastzip <= firstzip THEN
  833.     LOCATE 15, 15: PRINT "Last Zip must be greater than first Zip"
  834.     LOCATE 12, 1: PRINT STRING$(70, " ")
  835.     GOTO lastzip
  836.   END IF
  837.  
  838. OUTFL:
  839.   LOCATE 15, 1: PRINT STRING$(79, " ")
  840.   LOCATE 15, 10: INPUT "Enter drive and name of output file (e.g.,C:ZIPFILE.1)"; OUTFL$
  841.   LOCATE 17, 1: PRINT STRING$(79, " ")
  842.   FLAGERROR = 0: ON ERROR GOTO ERROR1: OPEN "O", 3, OUTFL$
  843.   IF FLAGERROR = 1 THEN GOTO OUTFL ELSE ON ERROR GOTO 0: GOTO HOUSETYPE2
  844. ERROR1:
  845.   LOCATE 17, 10: PRINT "Can't open file named "; OUTFL$; " -- try another file name..."
  846.   FLAGERROR = 1
  847.   RESUME NEXT
  848.  
  849.  
  850. HOUSETYPE2:
  851.   LOCATE
  852.   LOCATE 20, 20: PRINT "(1) NEW CONSTRUCTION  OR  (2) RETROFIT";
  853. 2000 Q$ = INKEY$: IF Q$ = "" THEN 2000 ELSE Q$ = UCASE$(Q$)
  854.     IF INSTR("12", Q$) = 0 THEN 2000
  855.   IF VAL(Q$) = 1 THEN
  856.     HT = 1
  857.     INSCOST$ = "INSCOST.NEW"
  858.   ELSE
  859.     HT = 2
  860.     INSCOST$ = "INSCOST.RET"
  861.   END IF
  862.   EXATTIC = 0: EXFLOOR = 0: EXCRAWL = 0
  863.   GOSUB MENU
  864.   FLAG = 0
  865.   FOR I = 1 TO 10
  866.     IF COMPONENT(I) = 1 THEN FLAG = 1
  867.   NEXT I
  868.   IF FLAG = 0 THEN PRINT : PRINT "YOU HAVE NOT DESIGNATED ANY COMPONENTS FOR ANALYSIS. PLEASE START OVER": END
  869.   EFF = 2'MEDIUM EFFICIENCY FOR HEATING AND COOLING SYSTEMS
  870.  
  871.   CLS
  872.   IF firstzip < 100 THEN FIRST$ = "0" + MID$(STR$(firstzip), 2, 2) ELSE FIRST$ = MID$(STR$(firstzip), 2, 3)
  873.   IF lastzip < 100 THEN LAST$ = "0" + MID$(STR$(lastzip), 2, 2) ELSE LAST$ = MID$(STR$(lastzip), 2, 3)
  874.   LOCATE 10, 26: PRINT USING "PROCESSING ZIPS & TO &"; FIRST$, LAST$
  875.   LOCATE 12, 35: PRINT "AT ZIP "
  876.  
  877. PRINTHEADING:
  878.   IF HT = 1 THEN PRINT #3, USING "New construction insulation alalysis for Zip Codes & to &"; FIRST$, LAST$
  879.   IF HT = 2 THEN PRINT #3, USING "Retrofit insulation analysis for Zip Codes & to &"; FIRST$, LAST$
  880.   PRINT #3, DATE$, TIME$
  881.   PRINT #3,
  882.   PRINT #3, "Heating System Types: "
  883.   FOR HSYS = 1 TO 5
  884.     PRINT #3, USING "(#) \                       \"; HSYS, HSYS$(HSYS)
  885.   NEXT HSYS
  886.   PRINT #3,
  887.   PRINT #3, "DESIGNATED COMPONENTS FOR ANALYSIS:"
  888.   IF COMPONENT(1) = 1 THEN PRINT #3, "(1) ATTIC    "
  889.   IF COMPONENT(2) = 1 OR COMPONENT(3) = 1 THEN PRINT #3, "Exterior walls:"
  890.   IF COMPONENT(2) = 1 THEN PRINT #3, "(2) WOOD FRAME "
  891.   IF COMPONENT(3) = 1 THEN PRINT #3, "(3) CONCRETE-MASONRY"
  892.   IF COMPONENT(4) = 1 OR COMPONENT(5) = 1 OR COMPONENT(6) = 1 THEN PRINT #3, "Floors/crawlspaces:"
  893.   IF COMPONENT(4) = 1 THEN PRINT #3, "(4) FLOORS OVER UNHEATED/UNINSULATED SPACES"
  894.   IF COMPONENT(5) = 1 THEN PRINT #3, "(5) SLAB FLOOR    "
  895.   IF COMPONENT(6) = 1 THEN PRINT #3, "(6) CRAWL SPACE WALLS"
  896.   IF COMPONENT(7) = 1 OR COMPONENT(8) = 1 THEN PRINT #3, "Basement walls - deep:"
  897.   IF COMPONENT(7) = 1 THEN PRINT #3, "(7) EXTERIOR INSULATION"
  898.   IF COMPONENT(8) = 1 THEN PRINT #3, "(8) INTERIOR INSULATION"
  899.   IF COMPONENT(9) = 1 OR COMPONENT(10) = 1 THEN PRINT #3, "Basement walls - shallow:"
  900.   IF COMPONENT(9) = 1 THEN PRINT #3, "(9) EXTERIOR INSULATION"
  901.   IF COMPONENT(10) = 1 THEN PRINT #3, "(10)INTERIOR INSULATION"
  902.   PRINT #3,
  903.   PRINT #3,
  904.   PRINT #3, "           Economic R-Values for Designated Components"
  905.   PRINT #3, "        ";
  906.   FOR I = 1 TO 10:
  907.     IF COMPONENT(I) = 1 THEN PRINT #3, "-----";
  908.   NEXT I: PRINT #3,
  909.   PRINT #3, "ZIP  HTG";
  910.   FOR I = 1 TO 10:
  911.     IF COMPONENT(I) = 1 THEN PRINT #3, USING "   ##"; I;
  912.   NEXT I: PRINT #3,
  913.   PRINT #3, "CODE SYS";
  914.   FOR I = 1 TO 10:
  915.     IF COMPONENT(I) = 1 THEN PRINT #3, "   --";
  916.   NEXT I: PRINT #3,
  917.  
  918.   FOR ZIP = firstzip TO lastzip
  919.     IF ZIP < 100 THEN ZIP$ = "0" + MID$(STR$(ZIP), 2, 2) ELSE ZIP$ = MID$(STR$(ZIP), 2, 3)
  920.     LOCATE 12, 42: PRINT ZIP$
  921.     GET #1, ZIP
  922.     DOE = CVI(DOE$)
  923.     IF DOE > 0 THEN
  924.       GOSUB CLIMATEDATA
  925.       IF CDH74 >= 2000 THEN AC = 1 'AC IS ALSO SET = 1 WHEN HEAT PUMP IS USED
  926.       COSTREG = CVI(COSTREG$)
  927.       IF COSTREG <> LASTCOSTREG THEN GOSUB INSCOST
  928.       IF DOE <> LASTDOE THEN
  929.     GOSUB ENPRICES
  930.     FOR HSYS = 1 TO 5
  931.       GOSUB HEATINGSYSEFF
  932.       J = HENERGY: GOSUB UPW: HUPW(HSYS) = UPW
  933.     NEXT HSYS
  934.     IF AC = 1 THEN
  935.         J = 1 'ELECTRICITY ALWAYS USED FOR COOLING
  936.         GOSUB UPW
  937.         CUPW = UPW
  938.     END IF
  939.     LASTDOE = DOE
  940.     LASTCOSTREG = COSTREG
  941.       END IF
  942.     
  943.       FOR HSYS = 1 TO 5
  944.     HUPW = HUPW(HSYS)
  945.     GOSUB HEATINGSYSEFF
  946.     HP = P(HENERGY, PIVOTYR) * GNPDEF1
  947.     IF AC = 1 THEN
  948.       GOSUB COOLINGSYSEFF
  949.       CP = P(CENERGY, PIVOTYR) * GNPDEF1
  950.     END IF
  951.     GOSUB COMPUTESAVINGS
  952. 'CONSTRAINTS
  953.     IF OPTIMAL(4) > OPTIMAL(1) THEN OPTIMAL(4) = OPTIMAL(1)'CRAWLSPACE WALL INSULATION CANNOT BE HIGHER THAN ATTIC INSULATION
  954.     IF OPTIMAL(3) > OPTIMAL(1) THEN OPTIMAL(3) = OPTIMAL(1)'FLOOR INSULATION CANNOT BE HIGHER THAN ATTIC INSULATION
  955.     IF HSYS = 1 THEN PRINT #3, USING "\ \   # "; ZIP$, HSYS;
  956.     IF HSYS > 1 THEN PRINT #3, USING "      # "; HSYS;
  957.     FOR I = 1 TO 10
  958.       IF COMPONENT(I) = 1 THEN PRINT #3, USING "   ##"; TOTR(I, OPTIMAL(I));
  959.     NEXT I: PRINT #3,
  960.       NEXT HSYS
  961.     END IF
  962.     
  963.   NEXT ZIP
  964.  
  965. LOCATE 17, 13: PRINT "Run completed for all houses and saved in file "; OUTFL$
  966. CLOSE
  967. END
  968. END IF
  969.                                         
  970. '----------------------------------------------------------------------------
  971. COMPUTESAVINGS:
  972. FOR I = 1 TO 12: OPTIMAL(I) = 0: NETSAVINGS(I) = 0: NEXT I'INITIALIZE VARIABLES
  973. IF DBUG = 1 THEN GOSUB DBUG0
  974.  
  975. 'ATTIC
  976. IF COMPONENT(1) = 1 THEN
  977.   HSLOPE = 25.91: CSLOPE = 1.978
  978.   EXISTINGR = ATTIC(EXATTIC)
  979.   ICOMP = 1: ICOST = 1
  980.   GOSUB DELTAENERGY
  981.   'PRINT:PRINT "ATTIC:" OPTIMAL(ICOMP),NETSAVINGS(OPTIMAL(ICOMP))
  982. END IF
  983.  
  984. 'WOOD-FRAME WALLS
  985. IF COMPONENT(2) = 1 THEN
  986.   HSLOPE = 21.19: CSLOPE = 1.005
  987.   EXISTINGR = 0
  988.   ICOMP = 2: ICOST = 2
  989.   GOSUB DELTAENERGY
  990. 'PRINT:PRINT "WF WALL:" OPTIMAL(2),NETSAVINGS(OPTIMAL(2))
  991. END IF
  992.  
  993. 'MASONRY WALLS (INSULATION INSIDE)
  994. IF COMPONENT(3) = 1 THEN
  995.   HSLOPE = 20.02: CSLOPE = .739
  996.   EXISTINGR = 0
  997.   ICOMP = 3: ICOST = 3
  998.   GOSUB DELTAENERGY
  999. 'PRINT:PRINT "MAS WALL:" OPTIMAL(3),NETSAVINGS(OPTIMAL(3))
  1000. END IF
  1001. '
  1002.  
  1003. 'WOOD FLOORS OVER CRAWLSPACE
  1004. IF COMPONENT(4) = 1 THEN
  1005.   EXISTINGR = FLOOR(EXFLOOR)
  1006.   ICOMP = 4: ICOST = 4
  1007.   RESTORE TYPE8
  1008.   GOSUB DELTAENERGY
  1009.   'PRINT:PRINT "FLOOR OVER CRAWL:" OPTIMAL(4),NETSAVINGS(OPTIMAL(4))
  1010. END IF
  1011.  
  1012. 'SLABS INSULATION -2 FT VERTICAL
  1013. IF COMPONENT(5) = 1 THEN
  1014.   EXISTINGR = 0
  1015.   ICOMP = 5: ICOST = 5
  1016.   RESTORE TYPE6
  1017.   GOSUB DELTAENERGY
  1018.   'PRINT:PRINT "SLAB FLOOR:" OPTIMAL(5),NETSAVINGS(OPTIMAL(5))
  1019. END IF
  1020.  
  1021. 'CRAWLSPACE WALLS - MASONRY -BATTS
  1022. IF COMPONENT(6) = 1 THEN
  1023.   EXISTINGR = CRAWL(EXCRAWL)
  1024.   ICOMP = 6: ICOST = 6
  1025.   RESTORE TYPE13
  1026.   GOSUB DELTAENERGY
  1027. END IF
  1028.  
  1029. 'BASEMENT WALLS (DEEP) - EXTERIOR INSULATION
  1030.   IF COMPONENT(7) = 1 THEN
  1031.    EXISTINGR = 0
  1032.    ICOMP = 7: ICOST = 7
  1033.    IF HT = 1 THEN RESTORE TYPE2
  1034.    IF HT = 2 THEN RESTORE TYPE1
  1035.    GOSUB DELTAENERGY
  1036.   END IF
  1037.   
  1038. 'BASEMENT WALLS (DEEP) - INTERIOR INSULATION
  1039. IF COMPONENT(8) = 1 THEN
  1040.   EXISTINGR = 0
  1041.   ICOMP = 8: ICOST = 8
  1042.   RESTORE TYPE4
  1043.   GOSUB DELTAENERGY
  1044. END IF
  1045.  
  1046. 'BASEMENT WALLS (SHALLOW) EXTERIOR INSULATION
  1047. IF COMPONENT(9) = 1 THEN
  1048.   EXISTINGR = 0
  1049.   ICOMP = 9: ICOST = 9
  1050.   RESTORE TYPE3
  1051.   GOSUB DELTAENERGY
  1052. END IF
  1053.  
  1054. 'BASEMENT WALLS (SHALLOW) - INTERIOR INSULATION
  1055. IF COMPONENT(10) = 1 THEN
  1056.   EXISTINGR = 0
  1057.   ICOMP = 10: ICOST = 8
  1058.   RESTORE TYPE5
  1059.   GOSUB DELTAENERGY
  1060. END IF
  1061.  
  1062. RETURN   'END COMPUTESAVINGS
  1063.  
  1064. '----------------------------------------------------------------------------
  1065. PRINTREPORT:
  1066. CLS
  1067. FLAG = 0
  1068. FOR I = 1 TO 12
  1069. IF COMPONENT(I) = 1 THEN FLAG = 1
  1070. NEXT I
  1071. IF FLAG = 0 THEN
  1072.   LOCATE 8, 1
  1073.       PRINT "           Since you have specified no components to be insulated,"
  1074.       PRINT "                 no insulation recommendations can be made."
  1075.   PRINT : INPUT "                         Press <CR> to start over...", Q$: GOTO ZIP
  1076. END IF
  1077.  
  1078.   LOCATE 1, 20: PRINT USING "Economic Insulation Levels for Zip &XX"; ZIP$
  1079.   X = LEN(CITY$) + 20: X = (80 - X) / 2
  1080.   LOCATE 2, X: PRINT USING "Reference Location: &"; CITY$
  1081.   IF HSYS = 5 THEN CSYS$(CSYS) = HSYS$(HSYS)'HEAT PUMP USED FOR COOLING
  1082.   LOCATE 3, 1: PRINT USING "  Heating system: \                    \  Cooling system: \                    \"; HSYS$(HSYS), CSYS$(CSYS)
  1083.   PRINT STRING$(79, "-")
  1084.   IF HT = 2 THEN
  1085.   EXR(1) = ATTIC(EXATTIC)
  1086.   EXR(4) = FLOOR(EXFLOOR)
  1087.   EXR(6) = CRAWL(EXCRAWL)
  1088.  
  1089.   LOCATE 5, 27: PRINT "Retrofit of Existing House"
  1090.   
  1091.   LOCATE 7, 1
  1092.    PRINT "                                          EXISTING     ADD     TOTAL"
  1093.   FLD$ = " \                                        \ R-##      R-##      R-##"
  1094.   FOR I = 1 TO 3
  1095.     IF COMPONENT(I) = 1 THEN PRINT USING FLD$; COMP$(I), EXR(I), ADDR(I, OPTIMAL(I)), EXR(I) + ADDR(I, OPTIMAL(I))
  1096.   NEXT I
  1097.  
  1098.   I = 4
  1099.   IF COMPONENT(I) = 1 THEN
  1100.     PRINT USING " \                                     \"; COMP$(I)
  1101.     PRINT USING FLD$; "   (If crawlspace walls are uninsulated)", EXR(I), ADDR(I, OPTIMAL(I)), EXR(I) + ADDR(I, OPTIMAL(I))
  1102.   END IF
  1103.  
  1104.   I = 6
  1105.   IF COMPONENT(I) = 1 THEN
  1106.     PRINT USING " \                                     \"; COMP$(I)
  1107.     PRINT USING FLD$; "   (If floor above is uninsulated)", EXR(I), ADDR(I, OPTIMAL(I)), EXR(I) + ADDR(I, OPTIMAL(I))
  1108.   END IF
  1109.  
  1110.   I = 5
  1111.   IF COMPONENT(I) = 1 THEN PRINT USING FLD$; COMP$(I), EXR(I), ADDR(I, OPTIMAL(I)), EXR(I) + ADDR(I, OPTIMAL(I))
  1112.  
  1113.   IF COMPONENT(7) = 1 OR COMPONENT(8) = 1 OR COMPONENT(9) = 1 OR COMPONENT(10) = 1 THEN
  1114.     PRINT " Insulation of Basement Walls:"
  1115.     FOR I = 7 TO 10
  1116.       IF COMPONENT(I) = 1 THEN PRINT USING FLD$; " " + COMP$(I), EXR(I), ADDR(I, OPTIMAL(I)), EXR(I) + ADDR(I, OPTIMAL(I))
  1117.     NEXT I
  1118.   END IF
  1119. END IF 'END EXISTING HOUSE
  1120.  
  1121. IF HT = 1 THEN
  1122.                FLD$ = "               \                                        \  R-##"
  1123.   LOCATE 5, 28: PRINT "New House Construction"
  1124.   PRINT
  1125.  
  1126.   FOR I = 1 TO 3
  1127.     IF COMPONENT(I) = 1 THEN PRINT USING FLD$; COMP$(I), ADDR(I, OPTIMAL(I))
  1128.   NEXT I
  1129.  
  1130.   I = 4
  1131.   IF COMPONENT(I) = 1 THEN
  1132.     PRINT USING "               \                                     \"; COMP$(I)
  1133.     PRINT USING FLD$; "   (If crawlspace walls are uninsulated)", ADDR(I, OPTIMAL(I))
  1134.   END IF
  1135.  
  1136.   I = 6
  1137.   IF COMPONENT(I) = 1 THEN
  1138.     PRINT USING "               \                                     \"; COMP$(I)
  1139.     PRINT USING FLD$; "   (If floor above is uninsulated)", ADDR(I, OPTIMAL(I))
  1140.   END IF
  1141.  
  1142.   I = 5
  1143.   IF COMPONENT(I) = 1 THEN PRINT USING FLD$; COMP$(I), ADDR(I, OPTIMAL(I))
  1144.  
  1145.   IF COMPONENT(7) = 1 OR COMPONENT(8) = 1 OR COMPONENT(9) = 1 OR COMPONENT(10) = 1 THEN
  1146.     PRINT "               Insulation of Basement Walls:"
  1147.     FOR I = 7 TO 10
  1148.       IF COMPONENT(I) = 1 THEN PRINT USING FLD$; " " + COMP$(I), ADDR(I, OPTIMAL(I))
  1149.     NEXT I
  1150.   END IF
  1151.  
  1152. END IF 'END NEW HOUSE
  1153.  
  1154. LOCATE 21, 1: PRINT STRING$(79, "-")
  1155. LOCATE 22, 1
  1156. IF COMPONENT(4) = 1 OR COMPONENT(6) = 1 THEN LOCATE , 20: PRINT "Press <PgDn> for additional information."
  1157. LOCATE , 13: PRINT "Press <SHIFT> <PrtSc> to print this screen if desired."
  1158. LOCATE , 18: PRINT "Press <ESC> to exit, R to do another analysis: ";
  1159.  
  1160. HELP1:
  1161. Q$ = INKEY$: IF Q$ = "" THEN GOTO HELP1
  1162. IF UCASE$(Q$) = "R" THEN GOTO ZIP
  1163. IF ASC(Q$) = 27 THEN GOTO TERMINATE
  1164. IF ASC(MID$(Q$, 1)) = 0 THEN X = ASC(MID$(Q$, 2))
  1165. IF X = 81 THEN GOTO FOOTNOTE
  1166. GOTO HELP1
  1167.  
  1168. TERMINATE:
  1169. CLS
  1170. END
  1171. '----------------------------------------------------------------------------
  1172.  
  1173. FOOTNOTE:
  1174. CLS
  1175.   PRINT "                           Additional information"
  1176. IF COMPONENT(4) = 1 AND COMPONENT(6) = 1 THEN
  1177.   PRINT
  1178.   PRINT "        Insulate either the floor over the crawlspace or the crawlspace"
  1179.   PRINT "        walls, not both.  Consult an insulation specialist to determine"
  1180.   PRINT "        which is more appropriate for your house."
  1181. END IF
  1182. IF COMPONENT(6) = 1 THEN
  1183.   PRINT
  1184.   PRINT "        Crawlspace walls should only be insulated if the crawlspace is "
  1185.   PRINT "        closed off, unventilated, and dry all year.  The ground should"
  1186.   PRINT "        be covered with a vapor barrier (e.g., 4- or 6-mil polyethylene"
  1187.   PRINT "        sheeting) to minimize moisture migration into the crawlspace."
  1188.   PRINT "        Note: some building codes may not allow unventilated crawlspaces."
  1189.   PRINT "        If radon gas is a problem at the building site, closing off the "
  1190.   PRINT "        crawlspace may not be advisable."
  1191. END IF
  1192. IF COMPONENT(4) = 1 THEN
  1193.   PRINT
  1194.   PRINT "        When insulating floors over crawlspaces or other unheated areas,"
  1195.   PRINT "        make sure that exposed water pipes are freeze-protected and "
  1196.   PRINT "        ductwork is well insulated in those areas. "
  1197. END IF
  1198.  
  1199. LOCATE 21, 1
  1200.   PRINT STRING$(78, "-")
  1201.   PRINT "              Press <SHIFT> <PrtSc> to print this screen if desired."
  1202.   PRINT "                 Press <PgUp> to show economic insulation levels: ";
  1203. HELP2:
  1204. Q$ = INKEY$: IF Q$ = "" THEN GOTO HELP2
  1205. IF ASC(MID$(Q$, 1)) = 0 THEN X = ASC(MID$(Q$, 2))
  1206. IF X = 73 THEN GOTO PRINTREPORT ELSE GOTO HELP2
  1207.  
  1208. '----------------------------------------------------------------------------
  1209. TRYAGAIN:
  1210.        LOCATE 25, 23: PRINT STRING$(35, " ");
  1211.        LOCATE II + 1, 25: PRINT "Press <CR> and try again...";
  1212. 3500       Q$ = INKEY$: IF Q$ <> CHR$(13) THEN 3500
  1213.        LOCATE II - 2, 5: PRINT STRING$(60, " ");
  1214.        LOCATE II - 1, 5: PRINT STRING$(60, " ");
  1215.        LOCATE II, 5: PRINT STRING$(60, " ");
  1216.        LOCATE II + 1, 5: PRINT STRING$(60, " ");
  1217.        RETURN
  1218. '----------------------------------------------------------------------------
  1219.  
  1220. UPW:
  1221. UPW = 0
  1222. FOR Y = PIVOTYR + 1 TO PIVOTYR + life(HT)
  1223.   IF P(J, Y) = 0 THEN P(J, Y) = P(J, Y - 1)
  1224.   DEFLATOR = P(J, Y) / P(J, PIVOTYR)
  1225.   UPW = UPW + DEFLATOR / (1 + DISCOUNTRATE) ^ (Y - PIVOTYR)
  1226. NEXT Y
  1227. RETURN
  1228.  
  1229. '-----------------------------------------------------------------------------
  1230. INSCOST:
  1231. CODE$(1) = "SQUARE": CODE$(2) = "LINEAR"
  1232. OPEN "I", 2, INSCOST$
  1233. INPUT #2, COMMENT$
  1234. INPUT #2, GNPDEF2
  1235. FOR I = 1 TO 12
  1236.   INPUT #2, REGFACTOR(I)
  1237. NEXT I
  1238. INPUT #2, NCOMPS
  1239. FOR I = 1 TO NCOMPS
  1240. INPUT #2, CAT, CAT$(CAT), NCAT(CAT), CODEAREA(CAT), MODEL(CAT)
  1241. INPUT #2, MESSAGE$(CAT)
  1242. IF MODEL(CAT) = 1 THEN INPUT #2, BASEU(CAT)
  1243. FOR K = 1 TO NCAT(CAT)
  1244. IF MODEL(CAT) = 1 THEN INPUT #2, ADDR(CAT, K), ULEVEL(CAT, K), cost(CAT, K)
  1245. IF MODEL(CAT) = 2 THEN INPUT #2, ADDR(CAT, K), cost(CAT, K)
  1246. cost(CAT, K) = cost(CAT, K) * REGFACTOR(COSTREG) * GNPDEF2
  1247. NEXT K
  1248. NEXT I
  1249. CLOSE 2
  1250. RETURN
  1251.  
  1252. '----------------------------------------------------------------------------
  1253. ENPRICES:
  1254. FL$ = "ENPRICES." + MID$(STR$(DOE), 2, 2)
  1255. OPEN "I", 2, FL$
  1256. INPUT #2, COMMENT$
  1257. INPUT #2, BASEYR, NYRS, GNPDEF1
  1258. FOR K = 1 TO 4
  1259. FOR I = 1 TO NYRS
  1260. INPUT #2, P(K, I)
  1261. NEXT I
  1262. NEXT K
  1263. CLOSE 2
  1264. CURYR = VAL(MID$(DATE$, 7, 4)): IF CURYR < 1988 THEN CURYR = 1989
  1265. PIVOTYR = CURYR - BASEYR + 1
  1266. RETURN
  1267.  
  1268. '---------------------------------------------------------------------------
  1269. HEATINGSYSEFF:
  1270. IF HSYS = 1 THEN HEFF = GASEFF(EFF): HENERGY = 4'NATURAL GAS
  1271. IF HSYS = 2 THEN HEFF = OILEFF(EFF): HENERGY = 2'FUEL OIL
  1272. IF HSYS = 3 THEN HEFF = RESISEFF(1): HENERGY = 1'ELECTRICITY
  1273. IF HSYS = 4 THEN HEFF = RESISEFF(2): HENERGY = 1'ELECTRICITY
  1274. IF HSYS = 5 THEN
  1275.    HEFF = 1.06 * (2.3 - .1 * HDD65 / 1000) * HPHSPF(EFF) / HPHSPF(2)'1.06 FORCES HSPF=6.5 AT 5000 HDD65 (DOE ZONE IV)
  1276.    CEFF = HPSEER(EFF) / 3.412
  1277.    HENERGY = 1'ELECTRICITY FOR HEATING WITH HEAT PUMP
  1278.    AC = 1: CENERGY = 1'ELECTRICITY FOR COOLING WITH HEAT PUMP
  1279.    IF DUCTS = 1 THEN CEFF = CEFF * DUCTEFF(STORIES)
  1280. END IF
  1281. IF HSYS = 6 THEN HEFF = GASEFF(EFF): HENERGY = 3'LPG
  1282. IF DUCTS = 1 THEN HEFF = HEFF * DUCTEFF(STORIES)
  1283. RETURN
  1284.  
  1285. '----------------------------------------------------------------------------
  1286. COOLINGSYSEFF:
  1287. IF CSYS = 1 THEN CEFF = SEER(EFF) / 3.412: CENERGY = 1
  1288. IF CSYS = 2 THEN CEFF = SEER(EFF) / 3.412: CENERGY = 1
  1289. IF DUCTS = 1 THEN CEFF = CEFF * DUCTEFF(STORIES)
  1290. RETURN
  1291.  
  1292. '----------------------------------------------------------------------------
  1293. CLIMATEDATA:
  1294.     HDD65 = CVI(HDD65$): HDD65 = HDD65 * 100
  1295.     CDH74 = CVI(CDH74$): CDH74 = CDH74 * 100
  1296.     RETURN
  1297.  
  1298. '---------------------------------------------------------------------------
  1299. BACKUP:
  1300. BACKUP$ = BU$(BUP): BUP = BUP - 1
  1301. IF BACKUP$ = "HSYSSELECT" THEN GOTO HSYSSELECT
  1302. IF BACKUP$ = "DUCTS" THEN GOTO DUCTS
  1303. IF BACKUP$ = "CSYSSELECT" THEN GOTO CSYSSELECT
  1304. IF BACKUP$ = "SHOWPRICES" THEN GOTO SHOWPRICES
  1305. IF BACKUP$ = "COMPONENTMENUNEW" THEN GOTO COMPONENTMENUNEW
  1306. IF BACKUP$ = "COMPONENTMENURET" THEN GOTO COMPONENTMENURET
  1307. IF BACKUP$ = "ATTIC" THEN GOTO ATTIC
  1308. IF BACKUP$ = "WFWALL" THEN GOTO WFWALL
  1309. IF BACKUP$ = "MWALL" THEN GOTO MWALL
  1310. IF BACKUP$ = "FLOOR" THEN GOTO FLOOR
  1311. IF BACKUP$ = "SLAB" THEN GOTO SLAB
  1312. IF BACKUP$ = "CRAWL" THEN GOTO CRAWL
  1313. IF BACKUP$ = "BASEMENT" THEN GOTO BASEMENT
  1314. IF BACKUP$ = "EXTDPBASE" THEN GOTO EXTDPBASE
  1315. IF BACKUP$ = "INTBASE" THEN GOTO INTBASE
  1316. IF BACKUP$ = "COMP1" THEN CLS : GOTO COMP1
  1317. IF BACKUP$ = "COMP2" THEN CLS : GOTO COMP2
  1318. IF BACKUP$ = "COMP3" THEN CLS : GOTO COMP3
  1319. IF BACKUP$ = "COMP4" THEN CLS : GOTO COMP4
  1320. IF BACKUP$ = "COMP5" THEN CLS : GOTO COMP5
  1321. IF BACKUP$ = "COMP6" THEN CLS : GOTO COMP6
  1322. IF BACKUP$ = "COMP7" THEN CLS : GOTO COMP7
  1323. IF BACKUP$ = "COMP8" THEN CLS : GOTO COMP8
  1324. IF BACKUP$ = "COMP9" THEN CLS : GOTO COMP9
  1325.  
  1326. PRINT "CANT FIND BACKUP CODE"
  1327. END
  1328.  
  1329. '----------------------------------------------------------------------------
  1330. COSTDISPLAY:
  1331.   LOCATE 4, (79 - LEN(INS$)) / 2: PRINT INS$
  1332.   LOCATE 5, (79 - LEN(MESSAGE$(ICOST))) / 2: PRINT MESSAGE$(ICOST)
  1333.   IF EX1 > 0 THEN LOCATE 6, 25: PRINT USING "To your existing R-## add:"; EX2
  1334.   FOR K = 1 TO NCAT(ICOST)
  1335.     LOCATE 6 + K, 25: PRINT USING "R-##  $$#.## per & foot"; ADDR(ICOST, K), cost(ICOST, K), CODE$(CODEAREA(ICOST))
  1336.   NEXT K: I = NCAT(ICOST) + 6
  1337.     LOCATE I + 2, 22: PRINT "Do you want to change these (Y/N)? ";
  1338. 2100 Q$ = INKEY$: IF Q$ = "" THEN 2100 ELSE Q$ = UCASE$(Q$)
  1339.     IF INSTR("SBYN", Q$) = 0 THEN 2100
  1340.     IF Q$ = "B" THEN GOTO BACKUP
  1341.     IF Q$ = "S" THEN GOTO ZIP
  1342.     IF Q$ = "Y" THEN
  1343.     LOCATE I + 2, 15: PRINT STRING$(50, " ")
  1344.     LOCATE I + 2, 15: PRINT "For each R level enter change or press <CR> if okay:"
  1345.     FOR K = 1 TO NCAT(ICOST)
  1346. COST1:
  1347.        LOCATE 25, 23: PRINT "Press <CR> when entry is complete.";
  1348.        LOCATE I + K + 2, 25: PRINT USING "R-##  $$#.## "; ADDR(ICOST, K), cost(ICOST, K); : INPUT "CHANGE TO: ", Q$: Q$ = UCASE$(Q$)
  1349.        IF Q$ = "B" AND K = 1 THEN CLS : GOTO COSTDISPLAY
  1350.        IF Q$ = "B" AND K > 1 THEN
  1351.       K = K - 1
  1352.       LOCATE I + K + 2, 25: PRINT STRING$(50, " ")
  1353.       LOCATE I + K + 3, 25: PRINT STRING$(50, " ")
  1354.       GOTO COST1
  1355.        END IF
  1356.        IF Q$ = "S" THEN GOTO ZIP
  1357.        IF Q$ <> "" THEN
  1358.      Q = VAL(Q$)
  1359.      II = I + K + 4: IF II > 24 THEN II = 24
  1360.      IF Q < .5 * cost(ICOST, K) OR Q > 3 * cost(ICOST, K) THEN
  1361.        LOCATE II, 20: PRINT USING "Cost must be between $$#.## and $$#.##"; .5 * cost(ICOST, K), 3 * cost(ICOST, K);
  1362.        GOSUB TRYAGAIN: GOTO COST1
  1363.      END IF
  1364.      IF K > 1 AND Q <= cost(ICOST, K - 1) THEN
  1365.        LOCATE II, 20: PRINT USING "Cost of R-## must be larger than cost of R-##"; ADDR(ICOST, K), ADDR(ICOST, K - 1)
  1366.        GOSUB TRYAGAIN: GOTO COST1
  1367.      END IF
  1368.      cost(ICOST, K) = Q
  1369.        END IF
  1370.        IF K > 1 AND cost(ICOST, K) <= cost(ICOST, K - 1) THEN
  1371.        II = I + K + 4: IF II > 24 THEN II = 24
  1372.        LOCATE II, 20: PRINT USING "Cost of R-## must be larger than cost of R-##"; ADDR(ICOST, K), ADDR(ICOST, K - 1)
  1373.        GOSUB TRYAGAIN: GOTO COST1
  1374.        END IF
  1375.      NEXT K
  1376.   CLS : GOTO COSTDISPLAY
  1377.   END IF
  1378. RETURN
  1379.  
  1380. '----------------------------------------------------------------------------
  1381. DELTAENERGY:
  1382.   TOTR(ICOMP, 0) = EXISTINGR
  1383.   FOR K = 1 TO NCAT(ICOST)
  1384.     TOTR(ICOMP, K) = EXISTINGR + ADDR(ICOST, K)
  1385.   NEXT K
  1386.   IF DBUG = 1 THEN GOSUB DBUG1
  1387.   OPTIMAL(ICOMP) = 0
  1388.  
  1389.   IF MODEL(ICOST) = 1 THEN
  1390.     IF EXISTINGR > 0 THEN  'CHANGE U VALUES TO REFLECT EXISTING INSULATIO
  1391.       ADDR(ICOST, 0) = 0
  1392.       ULEVEL(ICOST, 0) = BASEU(ICOST)
  1393.       FOR K = 0 TO NCAT(ICOST)
  1394.     REQUIV(K) = 1 / ULEVEL(ICOST, K)
  1395.       NEXT K
  1396.       FOR K = 0 TO NCAT(ICOST)
  1397.     IHIGH = 0
  1398.     FOR J = 1 TO NCAT(ICOST)
  1399.       IF TOTR(ICOMP, K) >= ADDR(ICOST, J - 1) AND TOTR(ICOMP, K) < ADDR(ICOST, J) THEN IHIGH = J: EXIT FOR
  1400.     NEXT J
  1401.     IF TOTR(ICOMP, K) >= ADDR(ICOST, NCAT(ICOST)) THEN IHIGH = NCAT(ICOST)
  1402.     ratio = (TOTR(ICOMP, K) - ADDR(ICOST, IHIGH - 1)) / (ADDR(ICOST, IHIGH) - ADDR(ICOST, IHIGH - 1)) 'changed 2-2-90
  1403.     REQUIV = REQUIV(IHIGH - 1) + ratio * (REQUIV(IHIGH) - REQUIV(IHIGH - 1))  'changed 2-2-90
  1404.     ULEVEL(ICOST, K) = 1 / REQUIV
  1405.       NEXT K
  1406.       BASEU(ICOST) = ULEVEL(ICOST, 0)
  1407.     END IF 'EXISTINGR>0
  1408.     FOR K = 1 TO NCAT(ICOST)
  1409.       DELTAU = BASEU(ICOST) - ULEVEL(ICOST, K)
  1410.       BETAH = HSLOPE * DELTAU
  1411.       BETAC = CSLOPE * DELTAU
  1412.       GOSUB DELTA2
  1413.     NEXT K
  1414.     IF DBUG = 1 THEN GOSUB DBUG3
  1415.     RETURN
  1416.   END IF 'MODEL = 1
  1417.  
  1418.   IF MODEL(ICOST) = 2 THEN   'NOTE: MODEL IS DEFINED IN INSPRICE FILE, THUS ICOST INDEX
  1419.      READ TITLE$, NR, BASEU
  1420.      BASER = 1 / BASEU
  1421.      RLEVEL(0) = 0: BASEBETAH = 0: BASEBETAC = 0
  1422.      FOR I = 1 TO NR
  1423.        READ RLEVEL(I), BETAH(I), BETAC(I) 'CHRISTIAN-STRZEPEK VARIABLES
  1424.      NEXT I
  1425.      FOR K = 0 TO NCAT(ICOST)
  1426.        DELTAU = 0  'U VALUES NOT USED IN THIS MODEL
  1427.        IF K > 0 OR EXISTINGR > 0 THEN  'IF K=0 AND EXISTINGR>0, FIND BASEBEATA AND BASEBETAC
  1428.      FOR J = 1 TO NR
  1429.        IF TOTR(ICOMP, K) >= RLEVEL(J - 1) AND TOTR(ICOMP, K) < RLEVEL(J) THEN IHIGH = J: EXIT FOR
  1430.      NEXT J
  1431.      IF TOTR(ICOMP, K) >= RLEVEL(NR) THEN IHIGH = NR
  1432.      BETAH = 0: BETAC = 0
  1433.      IF IHIGH > 1 THEN
  1434.        FOR I = 1 TO IHIGH - 1
  1435.          BETAH = BETAH + BETAH(I)
  1436.          BETAC = BETAC + BETAC(I)
  1437.        NEXT I
  1438.      END IF
  1439.      RL = RLEVEL(IHIGH - 1) + BASER
  1440.      RU = RLEVEL(IHIGH) + BASER
  1441.      RT = TOTR(ICOMP, K) + BASER
  1442.      ratio = (1 - RL / RT) / (1 - RL / RU)  'INTERPOLATION OF LAST CHRISTIAN-STRZEPEK COEFFICIENT
  1443.      BETAH = BETAH + ratio * BETAH(IHIGH)
  1444.      BETAC = BETAC + ratio * BETAC(IHIGH)
  1445.      IF K = 0 THEN BASEBETAH = BETAH: BASEBETAC = BETAC
  1446.      IF K > 0 AND EXISTINGR > 0 THEN BETAH = BETAH - BASEBETAH: BETAC = BETAC - BASEBETAC  'SUBTRACT OUT BETAS FOR EXISTING R
  1447.      IF K > 0 THEN GOSUB DELTA2
  1448.        END IF
  1449.      NEXT K
  1450.      IF DBUG = 1 THEN GOSUB DBUG3
  1451.      RETURN
  1452.   END IF 'MODEL(ICOMP)=2
  1453.  
  1454. DELTA2:
  1455.      DELTAAHR = BETAH * HDD65 / 1000000
  1456.      DELTAACR = BETAC * CDH74 / 1000000
  1457.      TOTSAVINGS = DELTAAHR / HEFF * HP * HUPW
  1458.      IF AC = 1 THEN TOTSAVINGS = TOTSAVINGS + DELTAACR / CEFF * CP * CUPW
  1459.      NETSAVINGS(K) = TOTSAVINGS - cost(ICOST, K)
  1460.      IF NETSAVINGS(K) > NETSAVINGS(OPTIMAL(ICOMP)) THEN OPTIMAL(ICOMP) = K
  1461.      IF DBUG = 1 THEN GOSUB DBUG2
  1462.      RETURN
  1463.  
  1464. 'DBUG SUBROUTINES PRINT A SUMMARY OF INTERMEDIATE CALCULATIONS TO FILE DBUG.ZIP
  1465. DBUG0:
  1466. OPEN "O", 1, "DBUG.ZIP"
  1467. PRINT #1, "VALIDATION DATA FOR ZIP:"
  1468. PRINT #1,
  1469. PRINT #1, "HEATING EFF = "; HEFF
  1470. PRINT #1, "COOLING EFF = "; CEFF
  1471. PRINT #1, "HEATING ENERGY PRICE PER MBTU = "; HP
  1472. PRINT #1, "COOLING ENERGY PRICE PER MBTU = "; CP
  1473. PRINT #1, "HEATING ENERGY UPW* = "; HUPW
  1474. PRINT #1, "COOLING ENERGY UPW* = "; CUPW
  1475. PRINT #1, "LOCATION = "; CITY$
  1476. PRINT #1, "ZIP = "; ZIP$
  1477. PRINT #1, "HDD65 = "; HDD65
  1478. PRINT #1, "CDH74 ="; CDH74
  1479. PRINT #1,
  1480. RETURN
  1481.  
  1482. DBUG1:
  1483. PRINT #1, "COMPONENT #"; ICOMP; COMP$(ICOMP)
  1484. PRINT #1, "  R   DELTA   BETAh    BETAc   DELTA    DELTA    DELTA    DELTA     TOTAL    COST      NET"
  1485. PRINT #1, "VALUE   U                       AHR      ACR    ENERGYh  ENERGYc   SAVINGS           SAVINGS"
  1486. RETURN
  1487.  
  1488. DBUG2:
  1489.   DFLD$ = " ##  #.#### ###.###  ###.###  #.#####  #.#####  #.#####  #.##### $$###.### $$#.### $$###.### "
  1490. PRINT #1, USING DFLD$; TOTR(ICOMP, K), DELTAU, BETAH, BETAC, DELTAAHR, DELTAACR, DELTAAHR / HEFF, DELTAACR / CEFF, TOTSAVINGS, cost(ICOST, K), NETSAVINGS(K)
  1491. RETURN
  1492.  
  1493. DBUG3:
  1494. PRINT #1, "OPTIMAL = "; OPTIMAL(ICOMP)
  1495. PRINT #1,
  1496. RETURN
  1497.  
  1498.  
  1499. '----------------------------------------------------------------------------
  1500. MENU:
  1501. CLS
  1502. LOCATE 1, 9: PRINT "     MARK INSULATION SYSTEMS OF INTEREST WITH AN X"
  1503. LOCATE 2, 9: PRINT "   (Use cursor to move up and down, <End> to finish)"
  1504. LOCATE , , 1, 1, 6
  1505. LOCATE 4, 12: PRINT "ATTIC           ": RW(1) = 4
  1506. LOCATE 5, 12: PRINT "Exterior walls:"
  1507. LOCATE 6, 14: PRINT "WOOD FRAME      ": RW(2) = 6
  1508. LOCATE 7, 14: PRINT "CONCRETE-MASONRY": RW(3) = 7
  1509. LOCATE 8, 12: PRINT "Floors/crawlspaces:"
  1510. LOCATE 9, 14: PRINT "FLOORS OVER UNHEATED/UNINSULATED SPACES": RW(4) = 9
  1511. LOCATE 10, 14: PRINT "SLAB FLOOR     ": RW(5) = 10
  1512. LOCATE 11, 14: PRINT "CRAWL SPACE WALLS": RW(6) = 11
  1513. LOCATE 12, 12: PRINT "Basement walls - deep:"
  1514. LOCATE 13, 14: PRINT "EXTERIOR INSULATION": RW(7) = 13
  1515. LOCATE 14, 14: PRINT "INTERIOR INSULATION": RW(8) = 14
  1516. LOCATE 15, 12: PRINT "Basement walls - shallow:"
  1517. LOCATE 16, 14: PRINT "EXTERIOR INSULATION": RW(9) = 16
  1518. LOCATE 17, 14: PRINT "INTERIOR INSULATION": RW(10) = 17
  1519. LOCATE 20, 23: PRINT "  Press <End> When finished.  "
  1520.  
  1521. FOR I = 1 TO 10: LOCATE RW(I), 55: PRINT "[ ]": NEXT I
  1522. FOR I = 1 TO 10: COMPONENT(I) = 0: NEXT I
  1523. I = 1
  1524.  
  1525. MENU1:
  1526. LOCATE RW(I), 56: A$ = INKEY$: IF A$ = "" THEN GOTO MENU1
  1527. IF UCASE$(A$) = "X" THEN
  1528.   COMPONENT(I) = 1
  1529.   PRINT "X"
  1530.   IF I < 10 THEN I = I + 1
  1531.   GOTO MENU1
  1532. END IF
  1533. IF A$ = " " THEN
  1534. DELEET:
  1535.   COMPONENT(I) = 0
  1536.   PRINT " "
  1537.   IF I < 10 THEN I = I + 1
  1538.   GOTO MENU1
  1539. END IF
  1540. IF LEFT$(A$, 1) = CHR$(0) THEN X = ASC(MID$(A$, 2)) ELSE X = ASC(A$)
  1541. IF X = 72 AND I > 1 THEN I = I - 1: GOTO MENU1'UP
  1542. IF X = 80 AND I < 10 THEN I = I + 1: GOTO MENU1'DOWN
  1543. IF X = 79 THEN GOTO MENU2
  1544. IF X = 83 THEN GOTO DELEET
  1545. GOTO MENU1
  1546.  
  1547. MENU2:
  1548. LOCATE 20, 14, 1, 6, 7: PRINT STRING$(50, " ")
  1549. LOCATE 20, 23: PRINT "Is selection completed (Y/N)? ";
  1550. 1100 QQ$ = INKEY$: IF QQ$ = "" THEN 1100 ELSE QQ$ = UCASE$(QQ$)
  1551. IF INSTR("SBYN", QQ$) = 0 THEN 1100
  1552. IF QQ$ = "B" THEN BU = 1: RETURN
  1553. IF QQ$ = "S" THEN GOTO ZIP
  1554. IF QQ$ = "Y" THEN RETURN
  1555. IF QQ$ = "N" THEN
  1556. LOCATE 20, 23: PRINT "  Press <End> When finished.  "
  1557.     GOTO MENU1
  1558. END IF
  1559.  
  1560. '----------------------------------------------------------------------------
  1561.  
  1562. TYPE1:
  1563. DATA PLASTIC FOAM ON UPPER HALF OF DEEP BASEMENT
  1564. DATA 6,.40
  1565. DATA 4, 20.69, 0.34
  1566. DATA 5,  1.01, 0.03
  1567. DATA 8,  1.92, 0.07
  1568. DATA 10, 0.86, 0.03
  1569. DATA 12, 0.70, 0.03
  1570. DATA 15, 0.89, 0.04
  1571.  
  1572. TYPE2:
  1573. DATA PLASTIC FOAM ON FULL HEIGHT OF DEEP BASEMENT
  1574. DATA 6,.40
  1575. DATA 4, 28.57, 0.45
  1576. DATA 5,  1.43, 0.02
  1577. DATA 8,  2.75, 0.03
  1578. DATA 10, 1.25, 0.01
  1579. DATA 12, 1.03, 0.01
  1580. DATA 15, 1.32, 0.02
  1581.  
  1582. TYPE3:
  1583. DATA PLASTIC FOAM ON FULL HEIGHT OF SHALLOW BASEMENT
  1584. DATA 6,0.40
  1585. DATA 4, 44.35, 0.95
  1586. DATA 5,  2.03, 0.04
  1587. DATA 8,  3.66, 0.07
  1588. DATA 10, 1.52, 0.02
  1589. DATA 12, 1.19, 0.02
  1590. DATA 15, 1.42, 0.02
  1591.  
  1592. TYPE4:
  1593. DATA BATT INSULATION ON INSIDE OF DEEP BASEMENT WALL
  1594. DATA 3,0.40
  1595. DATA 11,34.24,0.51
  1596. DATA 19, 0.96,0.01
  1597. DATA 30, 2.35,0.01
  1598.  
  1599. TYPE5:
  1600. DATA BATT INSULATION ON INSIDE OF SHALLOW BASEMENT WALL
  1601. DATA 3,0.40
  1602. DATA 11,51.36,1.08
  1603. DATA 19, 1.12,0.02
  1604. DATA 30, 2.50,0.03
  1605.  
  1606. TYPE6:
  1607. DATA SLAB ON GRADE - VERTICAL 2 FT
  1608. DATA 6,1
  1609. DATA 4,  2.79, 0.23
  1610. DATA 5,  0.15, 0.01
  1611. DATA 8,  0.31, 0.01
  1612. DATA 10, 0.15, 0.00
  1613. DATA 12, 0.13, 0.00
  1614. DATA 15, 0.17, 0.00
  1615.  
  1616. TYPE7:
  1617. DATA SLAB ON GRADE - VERTICAL 4 FT
  1618. DATA 6,1
  1619. DATA 4,  3.56, 0.23
  1620. DATA 5,  0.22, 0.01
  1621. DATA 8,  0.47, 0.01
  1622. DATA 10, 0.25, 0.00
  1623. DATA 12, 0.22, 0.00
  1624. DATA 15, 0.31, 0.00
  1625.  
  1626. TYPE8:
  1627. DATA FLOOR INSULATION
  1628. DATA 3,.25
  1629. DATA 11,1.7,.12
  1630. DATA 19,0.26,0
  1631. DATA 30,0.26,0
  1632.  
  1633. TYPE9:
  1634. DATA PERMANENT WOOD FOUNDATION BASEMENT WALL - DEEP
  1635. DATA 4,0.4
  1636. DATA 11,15.81,0.58
  1637. DATA 13, 1.08,0.00
  1638. DATA 19, 2.73,0.00
  1639. DATA 30, 4.39,0.00
  1640.  
  1641. TYPE10:
  1642. DATA PERMANENT WOOD FOUNDATION BASEMENT WALL - SHALLOW
  1643. DATA 4,0.4
  1644. DATA 11,27.42,1.15
  1645. DATA 13, 1.54,0.00
  1646. DATA 19, 3.69,0.00
  1647. DATA 30, 5.52,0.00
  1648.  
  1649. TYPE11:
  1650. DATA PERMANENT WOOD FOUNDATION BASEMENT WALL - CRAWLSPACE
  1651. DATA 4,0.4
  1652. DATA 11,09.90,0.59
  1653. DATA 13, 0.62,0.03
  1654. DATA 19, 1.53,0.07
  1655. DATA 30, 2.40,0.12
  1656.  
  1657. TYPE12:
  1658. DATA CONCRETE-MASONRY CRAWL SPACE WALLS -PLASTIC FOAM
  1659. DATA 4,0.4
  1660. DATA 5, 19.51,0.83
  1661. DATA 7,  1.08,0.03
  1662. DATA 10, 0.97,0.02
  1663. DATA 14, 0.81,0.02
  1664.  
  1665. TYPE13:
  1666. DATA CONCRETE-MASONRY CRAWL SPACE WALLS - BATTS
  1667. DATA 3,0.4
  1668. DATA 11, 21.80,0.93
  1669. DATA 13,  0.40,0.01
  1670. DATA 19,  0.87,0.02
  1671. '---------------------------------------------------------------------------
  1672. SCREEN1:
  1673. CLS
  1674. LN1$ = "             ZIP 1.0              "
  1675. LN2$ = "  THE ZIP-CODE INSULATION PROGRAM "
  1676. LN3$ = "    FOR NEW AND EXISTING HOUSES   "
  1677. LN4$ = "            (Nov 1988)            "
  1678.  
  1679. IYP = 2      'FIRST LINE
  1680. IWW = LEN(LN1$) + 5        'box width
  1681. IXP = INT((79 - IWW) / 2)  'center box
  1682. IWH = 6                    'box height
  1683. GOSUB DRAWWINDOW
  1684. LOCATE 3, 22: PRINT LN1$
  1685. LOCATE 4, 22: PRINT LN2$
  1686. LOCATE 5, 22: PRINT LN3$
  1687. LOCATE 6, 22: PRINT LN4$
  1688. RETURN
  1689.  
  1690. DRAWWINDOW:
  1691. LOCATE IYP, IXP - 1
  1692. PRINT CHR$(218); STRING$(IWW - 1, 196); CHR$(191)
  1693. FOR IY = IYP + 1 TO IYP + IWH - 2
  1694. LOCATE IY, IXP - 1
  1695. PRINT CHR$(179); SPACE$(IWW - 1); CHR$(179);
  1696. NEXT IY
  1697. LOCATE IYP + IWH - 1, IXP - 1
  1698. PRINT CHR$(192); STRING$(IWW - 1, 196); CHR$(217);
  1699. RETURN
  1700.  
  1701.  
  1702.